Configuration: Windows XP Internet Explorer 7.0
|
Hello Zero,
in the macro below, the loop For Each Mycell ... Next Mycell "reads" the contents of each cell in the given range (G11:G23) of the first table. Whatever the ID is, the same operations are completed : insert a row and copy out data from the first table into the second one ; this is done in the bundle With Marker .... End With . Only the initial cell changes. Thus the idea is to start the copy from a cell (named Marker) that depends on the ID ; this is done with Select Case ... End Select Ivan Sub Zeromaim()
Dim MyCell As Range, Marker As Range
Dim LowerBoundaryForA As Range, LowerBoundaryForB As Range, LowerBoundaryForC As Range
With Sheets("Sheet2")
Set LowerBoundaryForA = .Range("K12")
Set LowerBoundaryForB = .Range("K14")
Set LowerBoundaryForC = .Range("K16")
End With
Sheets("Sheet1").Activate
For Each MyCell In Range("G11:G23")
Select Case UCase(MyCell.Value)
Case Is = "A"
Set Marker = LowerBoundaryForA
Case Is = "B"
Set Marker = LowerBoundaryForB
Case Is = "C"
Set Marker = LowerBoundaryForC
End Select
With Marker
.EntireRow.Insert
.Offset(-1, 0).Value = MyCell.Offset(0, -1).Value
.Offset(-1, 1).Value = MyCell.Offset(0, 1).Value
.Offset(-1, 2).Value = MyCell.Offset(0, 2).Value
End With
Next MyCell
End Sub
|
Thanks Ivan,
Follow up question :) Kindly insert a code that if the ID is anything other than A, B, and C, the program will just skip to evaluate the next row (no inserting). If column G11:G23 reads as A, B, C, D, E, A, B, C, etc..., the program should not copy-insert the row associated to ID D, E, and other IDs. Thanks again and hope to hear from you soon. Anton |
|
Sub Zeromaim()
Dim MyCell As Range, Marker As Range
Dim LowerBoundaryForA As Range, LowerBoundaryForB As Range, LowerBoundaryForC As Range
With Sheets("Sheet2")
Set LowerBoundaryForA = .Range("K12")
Set LowerBoundaryForB = .Range("K14")
Set LowerBoundaryForC = .Range("K16")
End With
Sheets("Sheet1").Activate
For Each MyCell In Range("G11:G23")
Stop
Select Case UCase(MyCell.Value)
Case Is = "A"
Set Marker = LowerBoundaryForA
Case Is = "B"
Set Marker = LowerBoundaryForB
Case Is = "C"
Set Marker = LowerBoundaryForC
Case Else
Set Marker = Nothing
End Select
If Not Marker Is Nothing Then
With Marker
.EntireRow.Insert
.Offset(-1, 0).Value = MyCell.Offset(0, -1).Value
.Offset(-1, 1).Value = MyCell.Offset(0, 1).Value
.Offset(-1, 2).Value = MyCell.Offset(0, 2).Value
End With
End If
Next MyCell
End Sub |
Hi Ivan,
Thanks again, it's perfect. How do I change the status of this topic to resolve? Anyone? Anton |
Results for
Results for
Results for
Results for