Wrote some one-shot VBA code to move stuff around between a couple of Excel worksheets:
Public Function CompareTT(T_Div As String, T_ST As String, T_Add As String, _
S_Div As String, S_ST As String, S_Add As String) As Integer
'Returns -1 for "<", 0 for "=", 1 for ">" .
Dim Temp As Integer<br>
T_Div = Trim(LCase(T_Div)): T_ST = Trim(LCase(T_ST)): T_Add = Trim(LCase(T_Add))
S_Div = Trim(LCase(S_Div)): S_ST = Trim(LCase(S_ST)): S_Add = Trim(LCase(S_Add))
Temp = StrComp(T_Div, S_Div, vbTextCompare)
If Temp <> 0 Then
CompareTT = Temp
Exit Function
End If
Temp = StrComp(T_ST, S_ST, vbTextCompare)
If Temp <> 0 Then
CompareTT = Temp
Exit Function
End If
CompareTT = StrComp(T_Add, S_Add, vbTextCompare)
End Function
Public Sub CopyTT()
Dim Source As Range, Target As Range
Dim SourceRow As Integer, TargetRow As Integer
Dim CompareValue As Integer
Dim TempFormula As String
Dim SFormulaReplace As String
Dim TFormulaReplace As String
Const cDIV As Integer = 1
Const cST As Integer = 5
Const cAddress As Integer = 2
Const cHardWare As Integer = 13
Const cYearBuilt As Integer = 17
Const cSqFt As Integer = 19
Const cOccupancy As Integer = 21
Set Source = ThisWorkbook.Worksheets("Source").Cells
Set Target = ThisWorkbook.Worksheets("Target").Cells
SourceRow = 4: TargetRow = 4
Do While Source(SourceRow, cDIV) <> ""
CompareValue = CompareTT(Target(TargetRow, cDIV), _
Target(TargetRow, cST), _
Target(TargetRow, cAddress), _
Source(SourceRow, cDIV), _
Source(SourceRow, cST), _
Source(SourceRow, cAddress))
Select Case CompareValue
Case -1
TargetRow = TargetRow + 1
Case 0
'Calculate new formula
TempFormula = Source(SourceRow, cHardWare).Formula
SFormulaReplace = "Y" & SourceRow
TFormulaReplace = "Y" & TargetRow
TempFormula = Replace(TempFormula, SFormulaReplace, TFormulaReplace)
Target(TargetRow, cHardWare).Formula = TempFormula
Target(TargetRow, cYearBuilt) = Source(SourceRow, cYearBuilt)
Target(TargetRow, cSqFt) = Source(SourceRow, cHardWare)
Target(TargetRow, cOccupancy) = Source(SourceRow, cOccupancy)
TargetRow = TargetRow + 1
SourceRow = SourceRow + 1
Case 1
SourceRow = SourceRow + 1
End Select
Loop
Set Source = Nothing: Set Target = Nothing
End Sub
Sure it’s a hack, but it worked. It certainly beat looking through 500 rows of excel that span 30 columns and manually copying everything over.
Comments Off on What I Did At Work Today