Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to put data below data in a and b from columns c and d
Need Help! Have my macro putting first row of column C data in column A, but
need the rest of the column to go in as well. Also need to put the data from column D into column B ( C and D are a set that is of the same data type as a nd b respectively) Here is what I have so far.... fairly new to vba, but learning fast. Thanks!!! Sub Find_Blank() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to put data below data in a and b from columns c and d
Try this. I'd save your workbook though (JUST IN CASE)
Sub CopyMultipleColumns() 'Copy D to B Call CopyColumns(4, 2) 'Column D = 4, COlumn B = 2 'Copy C to A Call CopyColumns(3, 1) 'Column C = 3, Column A = 1 End Sub Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long) Dim lRow As Long Dim myRange As Range Dim aWS As Worksheet Set aWS = ActiveSheet Set myRange = aWS.Cells(1, CopyFromColumn) lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row Set myRange = myRange.Resize(lRow, 1) myRange.Offset(0, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2 End Sub -- HTH, Barb Reinhardt "EmmieLou" wrote: Need Help! Have my macro putting first row of column C data in column A, but need the rest of the column to go in as well. Also need to put the data from column D into column B ( C and D are a set that is of the same data type as a nd b respectively) Here is what I have so far.... fairly new to vba, but learning fast. Thanks!!! Sub Find_Blank() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to put data below data in a and b from columns c and d
Thanks Barb!
That is very close. The only problem now is that it pastes over the existing data in columns a and b. I need it to paste at the end of the existing data in columns a and b. I re-vamped my original macro and now it almost works too, except it is placing column c into columns a and b, and places coulmn d data below the dupe in column b.... Sub Find_Blank_Version2() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = C.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub Thanks again, any additional help is greatly appreciated EL "Barb Reinhardt" wrote: Try this. I'd save your workbook though (JUST IN CASE) Sub CopyMultipleColumns() 'Copy D to B Call CopyColumns(4, 2) 'Column D = 4, COlumn B = 2 'Copy C to A Call CopyColumns(3, 1) 'Column C = 3, Column A = 1 End Sub Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long) Dim lRow As Long Dim myRange As Range Dim aWS As Worksheet Set aWS = ActiveSheet Set myRange = aWS.Cells(1, CopyFromColumn) lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row Set myRange = myRange.Resize(lRow, 1) myRange.Offset(0, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2 End Sub -- HTH, Barb Reinhardt "EmmieLou" wrote: Need Help! Have my macro putting first row of column C data in column A, but need the rest of the column to go in as well. Also need to put the data from column D into column B ( C and D are a set that is of the same data type as a nd b respectively) Here is what I have so far.... fairly new to vba, but learning fast. Thanks!!! Sub Find_Blank() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to put data below data in a and b from columns c and d
Replace this sub
Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long) Dim lRow As Long Dim myRange As Range Dim aWS As Worksheet Set aWS = ActiveSheet Set myRange = aWS.Cells(1, CopyFromColumn) lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row Set myRange = myRange.Resize(lRow, 1) lRow = aWS.Cells(aWS.Rows.Count, CopyToColumn).End(xlUp).Row myRange.Offset(lRow, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2 End Sub -- HTH, Barb Reinhardt "EmmieLou" wrote: Thanks Barb! That is very close. The only problem now is that it pastes over the existing data in columns a and b. I need it to paste at the end of the existing data in columns a and b. I re-vamped my original macro and now it almost works too, except it is placing column c into columns a and b, and places coulmn d data below the dupe in column b.... Sub Find_Blank_Version2() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = C.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub Thanks again, any additional help is greatly appreciated EL "Barb Reinhardt" wrote: Try this. I'd save your workbook though (JUST IN CASE) Sub CopyMultipleColumns() 'Copy D to B Call CopyColumns(4, 2) 'Column D = 4, COlumn B = 2 'Copy C to A Call CopyColumns(3, 1) 'Column C = 3, Column A = 1 End Sub Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long) Dim lRow As Long Dim myRange As Range Dim aWS As Worksheet Set aWS = ActiveSheet Set myRange = aWS.Cells(1, CopyFromColumn) lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row Set myRange = myRange.Resize(lRow, 1) myRange.Offset(0, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2 End Sub -- HTH, Barb Reinhardt "EmmieLou" wrote: Need Help! Have my macro putting first row of column C data in column A, but need the rest of the column to go in as well. Also need to put the data from column D into column B ( C and D are a set that is of the same data type as a nd b respectively) Here is what I have so far.... fairly new to vba, but learning fast. Thanks!!! Sub Find_Blank() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to put data below data in a and b from columns c and d
Thanks Barb!!
That did the trick. Best wishes, and most appreciative. EL "Barb Reinhardt" wrote: Replace this sub Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long) Dim lRow As Long Dim myRange As Range Dim aWS As Worksheet Set aWS = ActiveSheet Set myRange = aWS.Cells(1, CopyFromColumn) lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row Set myRange = myRange.Resize(lRow, 1) lRow = aWS.Cells(aWS.Rows.Count, CopyToColumn).End(xlUp).Row myRange.Offset(lRow, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2 End Sub -- HTH, Barb Reinhardt "EmmieLou" wrote: Thanks Barb! That is very close. The only problem now is that it pastes over the existing data in columns a and b. I need it to paste at the end of the existing data in columns a and b. I re-vamped my original macro and now it almost works too, except it is placing column c into columns a and b, and places coulmn d data below the dupe in column b.... Sub Find_Blank_Version2() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = C.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub Thanks again, any additional help is greatly appreciated EL "Barb Reinhardt" wrote: Try this. I'd save your workbook though (JUST IN CASE) Sub CopyMultipleColumns() 'Copy D to B Call CopyColumns(4, 2) 'Column D = 4, COlumn B = 2 'Copy C to A Call CopyColumns(3, 1) 'Column C = 3, Column A = 1 End Sub Sub CopyColumns(CopyFromColumn As Long, CopyToColumn As Long) Dim lRow As Long Dim myRange As Range Dim aWS As Worksheet Set aWS = ActiveSheet Set myRange = aWS.Cells(1, CopyFromColumn) lRow = aWS.Cells(aWS.Rows.Count, myRange.Column).End(xlUp).Row Set myRange = myRange.Resize(lRow, 1) myRange.Offset(0, CopyToColumn - CopyFromColumn).Value2 = myRange.Value2 End Sub -- HTH, Barb Reinhardt "EmmieLou" wrote: Need Help! Have my macro putting first row of column C data in column A, but need the rest of the column to go in as well. Also need to put the data from column D into column B ( C and D are a set that is of the same data type as a nd b respectively) Here is what I have so far.... fairly new to vba, but learning fast. Thanks!!! Sub Find_Blank() Dim BCell, NBCell Range("A1").Select Range("B1").Select For i = 1 To 65536 If ActiveCell.Value = Empty Then 'First empty cell found; put in col c's stuff: BCell = "A" & CStr(i) Range("A" & CStr(i)).Select CCell = "B" & CStr(i) Range("B" & CStr(i)).Select For Each C In Worksheets("Sheet1").Range("C1:C100").Cells If C.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = C.Value Range("B" & CStr(i)).Select Range("B" & CStr(i)).Value = D.Value i = i + 1 Else 'Blank cell in col B found; get column stuff: '** For Each D In Worksheets("Sheet1").Range("D1:D100").Cells If D.Value < "" Then Range("A" & CStr(i)).Select Range("A" & CStr(i)).Value = D.Value i = i + 1 End If Next D Exit Sub '** End If Next C Exit Sub Else Range("A" & CStr(i + 1)).Select End If Next i End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
macro to compare few columns data of two spreadsheet | Excel Programming | |||
Creating a Macro for refreshing data in a columns | Excel Programming | |||
Macro to compare two columns of data | Excel Discussion (Misc queries) | |||
Macro to compare two columns of data | Excel Discussion (Misc queries) | |||
Macro to add data to the bottom of columns | Excel Discussion (Misc queries) |