Hello Mr. Excel forum!
In the past month and a half I have designed a macro at work, that after much sweat and many tears, finally does what I intended it to do. It was the second time that I made a macro with the last time many years ago. Since I had to google a lot to figure out how to write the code and since I found many answers within these fora, I thought it appropriate to post my code here to ask for feedback.
So my question is this: despite the code doing exactly what it needs to do, I have the feeling that it could be written a bit more neatly here and there, so I would like feedback if my code could have been written a bit more elegantly with better commands that currently I do not know how to make?
The code was developed to do this:
As a company we are supplying several devices to a client that all have varying amounts of hardwired IO. These IO are listed in an IO spreadsheet, with each device having it's own worksheet and each worksheet listsing all of the IO per device. There are hardwired IO as well as digital IO.
Depending on some parameters these digital IO need to be copied from the original IO spreadsheet (the source file) to another spreadsheet (the target file) to allow an import of all these digital signals into a SCADA system that monitors all devices. Whenever the combination of parameters determine that a certain IO needs to be copied from source to target file then four or five cells in row i in the source file get copied to row n in the target file.
In addition, the target file contains three worksheets that need to be filled with the same data, yet (annoyingly) the columns in the target file change from one worksheet to the other, therefore the macro needed to be set up such that it dynamically sets the columns before each itteration of a target file worksheet.
In the past month and a half I have designed a macro at work, that after much sweat and many tears, finally does what I intended it to do. It was the second time that I made a macro with the last time many years ago. Since I had to google a lot to figure out how to write the code and since I found many answers within these fora, I thought it appropriate to post my code here to ask for feedback.
So my question is this: despite the code doing exactly what it needs to do, I have the feeling that it could be written a bit more neatly here and there, so I would like feedback if my code could have been written a bit more elegantly with better commands that currently I do not know how to make?
The code was developed to do this:
As a company we are supplying several devices to a client that all have varying amounts of hardwired IO. These IO are listed in an IO spreadsheet, with each device having it's own worksheet and each worksheet listsing all of the IO per device. There are hardwired IO as well as digital IO.
Depending on some parameters these digital IO need to be copied from the original IO spreadsheet (the source file) to another spreadsheet (the target file) to allow an import of all these digital signals into a SCADA system that monitors all devices. Whenever the combination of parameters determine that a certain IO needs to be copied from source to target file then four or five cells in row i in the source file get copied to row n in the target file.
In addition, the target file contains three worksheets that need to be filled with the same data, yet (annoyingly) the columns in the target file change from one worksheet to the other, therefore the macro needed to be set up such that it dynamically sets the columns before each itteration of a target file worksheet.
Code:
Sub EMS()
'
' EMS Macro
'
Dim BI As Integer 'variable for amount of BI IO type per device
Dim BO As Integer 'variable for amount of BO IO type per device
Dim CT As Integer 'variable for amount of CT IO type per device
Dim VT As Integer 'variable for amount of VT IO type per device
Dim Tx As Integer 'variable for amount of Transmitters per device
Dim IntS As Integer 'variable for amount of internal signals per device
Dim IO As Integer 'variable to read amount of IO per worksheet (device) and per IO type
Dim i As Integer 'variable for looping through amount IO based on BI/BO/CT/VT
Dim j As Integer 'variable for amount of sheets in source file
Dim n As Integer 'variable for next row target file
Dim DP As Integer 'variable to determine double value or single value IO
Dim k As Integer 'variable to make another line in target file in case double signal
Dim m As Integer 'variable for reading sheet j a second time to copy internal signals
Dim S1 As Integer 'variable for amount of sheets in target file
Dim S2 As Integer 'variable for amount of sheets in source file
Dim Of As Integer 'variable to determine amount of row offset from first row in source file
Dim columnNrObj As Integer 'variable to determine which column to paste data to in target file
Dim columnNrTi As Integer 'variable to determine which column to paste data to in target file
Dim VeldNm As String 'variable for fieldname
Dim SourceFN As String 'variable to select source (source) file
Dim FileNameS As String 'variable to read only the file name from source file
Dim TargetFN As Variant 'variable to select target (target) file
Dim FileNameT As String 'variable to read only the file name from target file
Dim IOType1 As String 'variable to select IO type of internal signals
Dim IOType2 As String 'variable to select IO type of internal signals
Dim IOType3 As String 'variable to select IO type of internal signals
Dim Colour As Boolean 'variable switch on / off colouring of cells in source file
Colour = False
On Error GoTo EndMacro
MsgBox "Please open IO List source file" 'Ask user to select source file
SourceFN = Application.GetOpenFilename 'Load source file
If SourceFN = "False" Then GoTo EndMacro 'When a source file is not selected: end macro
FileNameS = Dir(SourceFN, vbDirectory) 'Read source file name
Application.ScreenUpdating = False
Workbooks.Open SourceFN 'Open source file
On Error Resume Next 'When source file is already open ignore error and continue macro
UserForm1.Show 'Show window with text "Running Macro, Please Wait"
On Error GoTo CloseSource 'On error close source file before end macro
For S1 = 2 To 4 'Loop through sheets 2 to 4 of target file
Windows("Target File.xlsm").Activate
Sheets(S1).Activate
n = 0 'Restore variable n to 0 at start of macro
BI = 0 'Restore variable BI to 0 at start of macro
BO = 0 'Restore variable BO to 0 at start of macro
CT = 0 'Restore variable CT to 0 at start of macro
VT = 0 'Restore variable VT to 0 at start of macro
Tx = 0 'Restore variable Tx to 0 at start of macro
Of = 0 'Restore variable Of to 0 at start of macro
IntS = 0 'Restore variable IntS to 0 at start of macro
Windows(FileNameS).Activate
S2 = Sheets.Count 'Count amount of sheets in source file
For j = 3 To S2 'Loop through sheets 3 to last sheet in source file
Windows(FileNameS).Activate
Sheets(j).Activate 'Start copying in sheet j of source file
If Cells(16, 21).Value <> "NCC" Then 'check if source file contains the valid data by reading cell(16, 21)
If MsgBox("This source file does not seem to be matching this macro!" & vbCrLf & "Do you want to continue running this macro?", vbYesNo) = vbNo Then GoTo CloseSource
End If 'when the source file does not match let the user choose to continue or end the macro
BI = Cells(3, 14).Value 'Read the amount of BI in sheet j
BO = Cells(4, 14).Value 'Read the amount of BO in sheet j
CT = Cells(5, 14).Value 'Read the amount of CT in sheet j
VT = Cells(6, 14).Value 'Read the amount of VT in sheet j
Tx = Cells(7, 14).Value 'Read the amount of Tx in sheet j
IntS = Cells(9, 14).Value 'Read the amount of IntS in sheet j
For m = 1 To 2 'Extra for loop to allow reading each sheet (j) twice
If S1 = 2 Then
If m = 1 Then
IO = BI 'for DI worksheet in target file set variable IO to the amount of BI in sheet j of source file
Of = 0 'for DI worksheet in target file put variable offset to 0
Else
IO = IntS 'for DI worksheet in target file set variable IO to the amount of IntS in sheet j of source file
Of = 4 + BI + 4 + BO + 4 + CT + VT + Tx
'for DI worksheet in target file set offset to the first row of internal signals
End If
columnNrObj = 35 'for DI worksheet in target file set columnnumber for object to 35
columnNrTi = 34 'for DI worksheet in target file set columnnumber for Ti to 34
IOType1 = "SP" 'for DI worksheet in target file only copy internal signals that match criterium
IOType2 = "DP" 'for DI worksheet in target file only copy internal signals that match criterium
IOType3 = "ST" 'for DI worksheet in target file only copy internal signals that match criterium
Else
If S1 = 3 Then
If m = 1 Then
IO = BO 'for DO worksheet in target file set variable IO to the amount of BI in sheet j of source file
Of = 4 + BI 'for DO worksheet in target file put variable offset to 0
Else
IO = IntS 'for DO worksheet in target file set variable IO to the amount of IntS in sheet j of source file
Of = 4 + BI + 4 + BO + 4 + CT + VT + Tx
'for DO worksheet in target file set offset to the first row of internal signals
End If
columnNrObj = 17 'for DO worksheet in target file set columnnumber for object to 17
columnNrTi = 16 'for DO worksheet in target file set columnnumber for Ti to 16
IOType1 = "SC" 'for DO worksheet in target file only copy internal signals that match criterium
IOType2 = "DC" 'for DO worksheet in target file only copy internal signals that match criterium
IOType3 = "DC" 'for DO worksheet in target file only copy internal signals that match criterium
Else
If m = 1 Then
IO = CT + VT + Tx 'for AI worksheet in target file set variable IO to the amount of BI in sheet j of source file
Of = 4 + BI + 4 + BO 'for AI worksheet in target file put variable offset to 0
Else
IO = IntS 'for AI worksheet in target file set variable IO to the amount of IntS in sheet j of source file
Of = 4 + BI + 4 + BO + 4 + CT + VT + Tx
'for AI worksheet in target file set offset to the first row of internal signals
End If
columnNrObj = 32 'for AI worksheet in target file set columnnumber for object to 32
columnNrTi = 31 'for AI worksheet in target file set columnnumber for Ti to 31
IOType1 = "MV" 'for AI worksheet in target file only copy internal signals that match criterium
IOType2 = "MV" 'for AI worksheet in target file only copy internal signals that match criterium
IOType3 = "MV" 'for AI worksheet in target file only copy internal signals that match criterium
End If
End If
For i = 1 To IO 'Loop through all IO per IO type in source file to determine if each IO needs to be copied or not
Windows(FileNameS).Activate
If m = 1 Then
If Cells(16 + Of + i, 21).Value = "Y" Or Cells(16 + Of + i, 21).Value = "y" Then
'If a cell in column 21 contains value Y or y several cells in this row need to be copied to target file
If Colour = True Then
Cells(16 + Of + i, 21).Select 'Make cell(16 + Of + i, 21) red when macro determins it needs to be copied
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
GoTo StartCopy
Else
If Colour = True Then
Cells(16 + Of + i, 21).Select 'If this cell in column 21 does not contain value Y or y make cell(16 + Of + i, 21) yellow and go to DontCopy
With Selection.Interior 'so the macro will read the next row in the source file
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
GoTo DontCopy
End If
GoTo DontCopy
End If
If m = 2 Then 'In second loop of reading IO in sheet (j) if a cell in column 21 contains value Y or y AND
'if a cell in column 13 matches one variable IOType 1, IOType 2 or IOType 3 several
'cells in this row need to be copied to target file
If Cells(16 + Of + i, 21).Value = "Y" Or Cells(16 + Of + i, 21).Value = "y" Then
If Cells(16 + Of + i, 13).Value = IOType1 Or Cells(16 + Of + i, 13).Value = IOType2 Or Cells(16 + Of + i, 13).Value = IOType3 Then
If S1 = 2 Then
If Colour = True Then
Cells(16 + Of + i, 21).Select 'Make cell(16 + Of + i, 21) color 12611584 when macro determins it needs to be copied
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
ElseIf S1 = 3 Then
If Colour = True Then
Cells(16 + Of + i, 21).Select 'If True set color of cell to 16711935
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16711935
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
Else
If Colour = True Then
Cells(16 + Of + i, 21).Select 'If True set color of cell to 5287936
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
End If
GoTo StartCopy
Else
If Colour = True Then
Cells(16 + Of + i, 21).Select 'In case value in column 21 does not equal Y or y set color of cell to 49407
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
GoTo DontCopy
End If
If Colour = True Then
Cells(16 + Of + i, 21).Select 'In case value in column 21 does not equal Y or y set color of cell to 65535
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
GoTo DontCopy
End If
If Colour = True Then
Cells(16 + Of + i, 21).Select 'In case value in column 21 does not equal Y or y set color of cell to 65535
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
GoTo DontCopy
End If
StartCopy:
Windows(FileNameS).Activate
If m = 1 Then
If Cells(16 + Of + i, 13).Value = "DP" Or Cells(16 + Of + i, 13).Value = "DC" Then
DP = 2 'In case cell value matches DP/DC, set variabele DP to 2
Else
DP = 1 'In case cell value does not match DP/DC, set variabele DP to 1
End If
Else
DP = 1
End If
For k = 1 To DP 'In case cell value matches DP/DC, make additional loop
Windows(FileNameS).Activate
VeldNm = ActiveSheet.Name 'write sheetname of targetfile to variabele VeldNm
Windows("SourceFile.xlsm").Activate
Cells(5 + n, 2).Value = VeldNm 'write variabele VeldNm to second cell in row target file
If k = 1 Then 'in first k-loop read value from line i for unique identifier
Windows(FileNameS).Activate
VeldNm = (ActiveSheet.Name & "_" & Cells(16 + Of + i, 8).Value) 'Give unique identifier to each signal
Windows("SourceFile.xlsm").Activate
Cells(5 + n, 4).Value = VeldNm
Windows(FileNameS).Activate
If Cells(16 + Of + i, 13).Value = "DP" Or Cells(16 + Of + i, 13).Value = "DC" Then
VeldNm = Cells(16 + Of + i, 58).Value & " " & Cells(16 + Of + i, 19).Value
Else
VeldNm = Cells(16 + Of + i, 58).Value
End If
'assign two cell values to variable VeldNm
Windows("SourceFile").Activate
Cells(5 + n, 3).Value = VeldNm 'write variabele VeldNm to cell in source file
Else 'in second k-loop read value from line i+1 for unique identifier
Windows(FileNameS).Activate
VeldNm = (ActiveSheet.Name & "_" & Cells(16 + Of + i + 1, 8).Value) 'Give unique identifier to each signal
Windows("SourceFile").Activate
Cells(5 + n, 4).Value = VeldNm
Windows(FileNameS).Activate
If Cells(16 + Of + i, 13).Value = "DP" Or Cells(16 + Of + i, 13).Value = "DC" Then
VeldNm = Cells(16 + Of + i, 58).Value & " " & Cells(16 + Of + i, 19).Value
Else
VeldNm = Cells(16 + Of + i, 58).Value
End If
'assign two cell values to variable VeldNm
Windows("SourceFile").Activate
Cells(5 + n, 3).Value = VeldNm 'write variabele VeldNm to cell in source file
End If
Windows(FileNameS).Activate
VeldNm = ("'=" & Cells(4, 9).Value & " " & Cells(5, 9).Value & " " & Cells(6, 9).Value & " " & Cells(7, 9).Value) 'Assign cell values to variabele VeldNm
Windows("SourceFile").Activate
Cells(5 + n, 5).Value = VeldNm 'write value of variable VeldNm to cell source file
Cells(5 + n, KolomNrObj).Select 'select cell in source file via variabele KolomNrObj
Windows(FileNameS).Activate
Cells(16 + Of + i, 39).Select 'Select cell in source file
Application.CutCopyMode = False
Selection.Copy
Windows("SourceFile").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'paste value to source file
Cells(5 + n, KolomNrTi).Select 'select cell in source file via variabele KolomNrTi
Windows(FileNameS).Activate
Cells(16 + Of + i, 40).Select 'Select cell in source file
Application.CutCopyMode = False
Selection.Copy
Windows("SourceFile").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'paste value to source file
n = n + 1 'next row target file
Next k 'next row target file in case DP / DC type signal
DontCopy:
Next i 'next row source file
Next m 'second loop reading values from sheet j source file to copy internal signals
Next j 'next sheet source file
Next S1 'next sheet in target file
Windows("Target File.xlsm").Activate 'Select target file
Application.ScreenUpdating = True
Application.DisplayAlerts = False
UserForm1.Hide
Do
TargetFN = Application.GetSaveAsFilename(InitialFileName:="Target File", filefilter:=" Excel Macro Free Workbook (*.xlsx), *.xlsx,")
Loop Until TargetFN <> False 'force user to save target file as .xlsx to user selectable location
ActiveWorkbook.SaveAs FileName:=TargetFN, FileFormat:=xlOpenXMLWorkbook
MsgBox "File Saved!"
CloseSource:
If Colour = False Then
Windows(FileNameS).Close 'close source file
Else
End If
EndMacro:
UserForm1.Hide
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
