Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Sub ReArrangeDataVersion4() Dim sws As Worksheet, dws As Worksheet Dim lr As Long, lc As Long, i As Long, dlr As Long Dim x, y Dim TimeTaken As Date TimeTaken = Now Application.ScreenUpdating = False Set sws = Sheets("Sheet1") Set dws = Sheets("Output") lr = sws.Cells(Rows.Count, 1).End(xlUp).Row lc = sws.Cells(1, Columns.Count).End(xlToLeft).Column dlr = dws.Cells(Rows.Count, 2).End(xlUp).Row If dlr > 1 Then dws.Range("A2:G" & dlr).Clear y = sws.Range("A4:A" & lr).Value For i = 2 To lc Step 8 DoEvents dlr = dws.Range("B" & Rows.Count).End(3)(2).Row dws.Range("B" & dlr).Offset(0, -1) = sws.Cells(1, i) dws.Range("B" & dlr).Resize(UBound(y, 1)).Value = y x = sws.Range(sws.Cells(4, i), sws.Cells(lr, i + 7)).Value dws.Range("C" & dlr).Resize(UBound(y, 1), 8).Value = x Next i dlr = dws.Cells(Rows.Count, 2).End(xlUp).Row dws.Range("A2:A" & dlr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" dws.Range("A2:A" & dlr).Value = dws.Range("A2:A" & dlr).Value dws.Columns.AutoFit dws.Range("A1").CurrentRegion.Borders.Color = vbBlack dws.Activate Application.ScreenUpdating = True MsgBox "Time taken to process data was " & Format(Now - TimeTaken, "hh:mm:ss") End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.