I wonder whether someone may be able to help me please.
I have an Excel (2003) spreadsheet called ‘Input’ with data in columns B to N. What I would like to be able to do is if there is text in any of the cells in column B, I would like to copy the row but only columns ‘B’ ‘I’ and ‘N’ and paste them into my second spreadsheet called ‘Output’ at cell ref B2.
If at all possible, once the information has been pasted, I’d like to add the word ‘Scheduled site’ in column ‘E’ on the ‘Output’ sheet if the cells in column ‘B’ have text in them.
I’ve been doing this manually, and it takes quite some time to do.
I just wondered whether someone may be able to show me please how I can automate this.
if your data looks like below, and you text entries are not formulae, then this approach will be very fast as it exploits SpecialCells to avoid looping rows
Sub MoveEM2() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Set ws1 = Sheets("Input") Set ws2 = Sheets("Output") On Error Resume Next Set rng1 = ws1.Columns("B").SpecialCells(xlConstants) On Error GoTo 0 If rng1 Is Nothing Then Exit Sub Application.ScreenUpdating = False Set rng2 = ws2.[b2] rng1.Copy rng2 'copy column I to Output C2 rng1.Offset(0, 7).Copy rng2.Offset(0, 1) 'copy column N to Output d2 rng1.Offset(0, 12).Copy rng2.Offset(0, 2) rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site" Application.ScreenUpdating = True End Sub
[updated for further query]
Sub MoveEM() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Set ws1 = Sheets("Input") Set ws2 = Sheets("Output") On Error Resume Next Set rng1 = ws1.Range(ws1.[b4], ws1.Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlConstants) On Error GoTo 0 If rng1 Is Nothing Then Exit Sub Application.ScreenUpdating = False Set rng2 = ws2.[b2] rng1.Copy rng2.PasteSpecial xlPasteValues 'copy column I to Output C2 rng1.Offset(0, 7).Copy rng2.Offset(0, 1).PasteSpecial xlPasteValues 'copy column N to Output d2 rng1.Offset(0, 12).Copy rng2.Offset(0, 2).PasteSpecial xlPasteValues rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site" Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
I was looking to do the same in a Google Docs spreadsheet so macros were out, I managed to do it with some IFs and VLOOKUPs. It seems a bit convoluted, maybe someone has a more effective way to do this, but this should work without macros:
To the left of the input, I created a column starting with 0 and incrementing every time column B has data in it:
A1=0 A2=IF(ISBLANK(B2),A1,A1+1) A3=IF(ISBLANK(B3),A2,A2+1) ...
so the first sheet looks like this:
0 1 data1 1 2 data2 3 data3 3 3 4 data4
Then on the output sheet, have a column with simply incrementing values and do a vlookup for the first row containing that number:
A1=1 A2=2 ...
B1=VLOOKUP(A1,Sheet1!A:B,2,FALSE) B2=VLOOKUP(A2,Sheet1!A:B,2,FALSE) ...
So the second sheet looks like this:
1 data1 2 data2 3 data3 4 data4
Do another vlookup for any other columns you want to transfer from the first sheet, then hide the columns with the numbers in them.
Just in case, you know how to handle this here is an example. Remember, everyone does things differently, so this is probably not the fastest or most elegant way.
Sub MoveData() Sheets("Output").Select 'Select the input sheet OutputRowCounter = Range("A65536").End(xlUp).Row + 1 'find the last used row in column A of the output sheet Sheets("Input").Select 'Select the input sheet InputMaxRow = Range("A65536").End(xlUp).Row 'find the last used row in column A of the input sheet For rowLoop = 2 To InputMaxRow 'loop through the file and copy data from columns B-N to output A-M If Cells(rowLoop, 2).Value <> "" Then 'if the current cell (changing row and fixed column B) has any data... For ColLoop = 2 To 14 'Loop through columns B-N Worksheets("Output").Cells(OutputRowCounter, ColLoop - 1).Value = Cells(rowLoop, ColLoop).Value 'copy selected data Next ColLoop 'go to next column OutputRowCounter = OutputRowCounter + 1 'store the next row in the output sheet End If Next rowLoop End Sub
Here’s another way to do it. This puts your data in an array and then looks through the array for rows that have values in Column B. This should run a little faster than going through your column/sheet cell by cell, but the difference will probably be noticeable only for large data sets.
Sub summarize() Dim sIn As Worksheet, sOut As Worksheet, rIn As Range, rOut As Range Dim inputdata() As Variant Dim tmpArr(1 To 3) As Variant Dim i As Long, outcount As Long Set sIn = Sheets("Input") Set sOut = Sheets("Output") Set rIn = sIn.UsedRange Set rOut = sOut.Range("B2:D2") 'Loads input data into an array for fast processing. inputdata = rIn.Value outcount = 0 'Reads data from inputdata Array and prints selected values from columns B, I, and N on Output sheet row by row. For i = 1 To UBound(inputdata, 1) If inputdata(i, 1) <> "" Then outcount = outcount + 1 tmpArr(1) = inputdata(i, 1) tmpArr(2) = inputdata(i, 8) tmpArr(3) = inputdata(i, 13) rOut.Offset(outcount - 1, 0).Value = tmpArr Erase tmpArr End If Next i Erase inputdata 'Add "Scheduled Site" to Column E of Output data. If sOut.Range("B2") <> "" Then sOut.Range("E2") = "Scheduled Site" sOut.Range("E2").AutoFill Destination:=sOut.Range("E2", sOut.Range("E2").Offset(outcount - 1, 0)) End If End Sub