YellowLabPro
05-20-2006, 02:20 PM
The following code has been altered originally by a board member. I am using this as my initial kickoff for developing a new function. With no experience, I am trying to understand VBA through code written by others and then modify it to fit my needs.
Would someone edit this to do the following tasks? Or start a new file. I will use it to compare between the two for learning purposes.
Copy these particular columns from worksheet TGFF to worksheet Data; Columns A, C, D, E, M, and AP starting in Column B. I would need the term Fairfax to be inserted in Column A and copy down as far as the number of records that will be populated from the TGFF worksheet.
Option Explicit
'
Sub FairfaxItemRecords()
'
Dim FirstAddress As String, Cell As Range
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'
'========================
With Sheets("TGFF").Columns("E")
Set Cell = .Find(What:="~~P", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ParentData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
'
End If
'
'---------------------------------------------
'
Set Cell = .Find(What:="~~C", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ChildData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
'
End If
End With
'
'========================
'
With Sheets("TGVB").Columns("E")
Set Cell = .Find(What:="~~P", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ParentData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End If
'
'---------------------------------------------
'
Set Cell = .Find(What:="~~C", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ChildData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
'
End If
End With
'========================
'
'
With Sheets("ParentData")
.Columns(3).Replace What:="~~P", Replacement:="", MatchCase:=False
For Each Cell In .Range("C2", Range("C" & Rows.Count).End(xlUp).Address)
Cell = Trim(Cell)
Next
.Range("A1") = "Parent Item#"
.Range("B1") = "Parent Item Description"
.Range("C1") = "Parent Trimmed"
End With
'
'---------------------------------------------
'
With Sheets("ChildData")
.Columns(3).Replace What:="~~C", Replacement:="", MatchCase:=False
For Each Cell In .Range("C2", Range("C" & Rows.Count).End(xlUp).Address)
Cell = Trim(Cell)
Next
.Range("A1") = "Child Item#"
.Range("B1") = "Child Item Description"
.Range("C1") = "Child Trimmed"
End With
'
'---------------------------------------------
'
Set Cell = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'
End Sub
Thanks,
YLP
Would someone edit this to do the following tasks? Or start a new file. I will use it to compare between the two for learning purposes.
Copy these particular columns from worksheet TGFF to worksheet Data; Columns A, C, D, E, M, and AP starting in Column B. I would need the term Fairfax to be inserted in Column A and copy down as far as the number of records that will be populated from the TGFF worksheet.
Option Explicit
'
Sub FairfaxItemRecords()
'
Dim FirstAddress As String, Cell As Range
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'
'========================
With Sheets("TGFF").Columns("E")
Set Cell = .Find(What:="~~P", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ParentData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
'
End If
'
'---------------------------------------------
'
Set Cell = .Find(What:="~~C", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ChildData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
'
End If
End With
'
'========================
'
With Sheets("TGVB").Columns("E")
Set Cell = .Find(What:="~~P", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ParentData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End If
'
'---------------------------------------------
'
Set Cell = .Find(What:="~~C", LookIn:=xlValues, LookAt:=xlPart)
'
If Not Cell Is Nothing Then
'
FirstAddress = Cell.Address
'
Do
With Sheets("ChildData").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0) = Cell.Offset(0, -4)
.Offset(1, 1) = Cell
.Offset(1, 2) = Cell
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
'
End If
End With
'========================
'
'
With Sheets("ParentData")
.Columns(3).Replace What:="~~P", Replacement:="", MatchCase:=False
For Each Cell In .Range("C2", Range("C" & Rows.Count).End(xlUp).Address)
Cell = Trim(Cell)
Next
.Range("A1") = "Parent Item#"
.Range("B1") = "Parent Item Description"
.Range("C1") = "Parent Trimmed"
End With
'
'---------------------------------------------
'
With Sheets("ChildData")
.Columns(3).Replace What:="~~C", Replacement:="", MatchCase:=False
For Each Cell In .Range("C2", Range("C" & Rows.Count).End(xlUp).Address)
Cell = Trim(Cell)
Next
.Range("A1") = "Child Item#"
.Range("B1") = "Child Item Description"
.Range("C1") = "Child Trimmed"
End With
'
'---------------------------------------------
'
Set Cell = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'
End Sub
Thanks,
YLP