update Generic Master bas7
This commit is contained in:
@@ -1,10 +1,11 @@
|
||||
' ====== (222) =======
|
||||
|
||||
' ====== Constants ======
|
||||
Const START_COL As Long = 3
|
||||
Const END_COL As Long = 14
|
||||
Const START_COL As Long = 3 ' C column
|
||||
Const END_COL As Long = 14 ' N column
|
||||
Const ERROR_COL As Long = 15 ' O column
|
||||
|
||||
Private z1Cache As Object '
|
||||
Private z1Cache As Object ' Z1 cache
|
||||
|
||||
' ====== Function ======
|
||||
Public Sub RefreshZ1Cache()
|
||||
@@ -71,7 +72,7 @@ Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
' Clear columns D onwards
|
||||
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
|
||||
ws.Cells(rowNum, 6).Validation.Delete
|
||||
ws.Cells(rowNum, 19).ClearContents ' Column Q - error info
|
||||
ws.Cells(rowNum, ERROR_COL).ClearContents ' Column Q - error info
|
||||
End Sub
|
||||
|
||||
Sub M1_Import()
|
||||
@@ -116,9 +117,9 @@ Sub M1_Import()
|
||||
Next j
|
||||
|
||||
' Auto-fill D, E columns from Z1
|
||||
' Call FillFromZ1(wsTarget, writeRow, False)
|
||||
Call FillFromZ1(writeRow)
|
||||
|
||||
writeRow = writeRow +
|
||||
writeRow = writeRow + 1
|
||||
Next i
|
||||
|
||||
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
||||
@@ -128,99 +129,91 @@ ImportError:
|
||||
MsgBox "CSV import failed: " & Err.Description, vbExclamation
|
||||
End Sub
|
||||
|
||||
Sub validate(ByVal rowNum As Long)
|
||||
Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
Set ws = Me
|
||||
|
||||
' Check C column not empty
|
||||
If Trim(ws.Cells(rowNum, 3).Value) = "" Then
|
||||
ws.Cells(rowNum, 19).ClearContents
|
||||
Dim clearRange As Range
|
||||
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
' Check column required
|
||||
Dim colLetter As Variant
|
||||
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
|
||||
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required"
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
' Check G (column 9), H (column 10) required and numeric (for composite key)
|
||||
If Trim(ws.Cells(rowNum, 9).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 9).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "G column (I) is required and must be numeric"
|
||||
' Check column numeric
|
||||
For Each colLetter In Array("H", "I", "G", "N")
|
||||
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
|
||||
If val <> "" And Not IsNumeric(val) Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column must be numeric"
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
If Trim(ws.Cells(rowNum, 10).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 10).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "H column (J) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check I (column 11) required
|
||||
If Trim(ws.Cells(rowNum, 11).Value) = "" Then
|
||||
ws.Cells(rowNum, 19).Value = "I column (K) is required"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check J (column 12), K (column 13) required and numeric
|
||||
If Trim(ws.Cells(rowNum, 12).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 12).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "J column (L) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Trim(ws.Cells(rowNum, 13).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 13).Value) Then
|
||||
ws.Cells(rowNum, 19).Value = "K column (M) is required and must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check L-P (columns 14-18) optional but must be numeric if entered
|
||||
Dim col As Long
|
||||
Dim colName As String
|
||||
Dim colLetter As String
|
||||
colLetter = "NOPQR"
|
||||
|
||||
For col = 14 To 18
|
||||
If Trim(ws.Cells(rowNum, col).Value) <> "" And Not IsNumeric(ws.Cells(rowNum, col).Value) Then
|
||||
colName = Mid(colLetter, col - 13, 1)
|
||||
ws.Cells(rowNum, 19).Value = colName & " column must be numeric"
|
||||
Exit Sub
|
||||
End If
|
||||
Next col
|
||||
|
||||
' Check G-H composite key for duplicates
|
||||
Dim g As String, h As String
|
||||
Dim r As Long
|
||||
Dim lastRow As Long
|
||||
|
||||
g = Trim(ws.Cells(rowNum, 9).Value)
|
||||
h = Trim(ws.Cells(rowNum, 10).Value)
|
||||
|
||||
lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
|
||||
|
||||
For r = 7 To lastRow
|
||||
If r <> rowNum And Trim(ws.Cells(r, 3).Value) = Trim(ws.Cells(rowNum, 3).Value) Then
|
||||
If Trim(ws.Cells(r, 9).Value) = g And Trim(ws.Cells(r, 10).Value) = h Then
|
||||
ws.Cells(rowNum, 19).Value = "GH (I,J) combination already exists"
|
||||
' Check C column repeat
|
||||
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
||||
Dim foundCell As Range
|
||||
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
|
||||
If Not foundCell Is Nothing Then
|
||||
If foundCell.Row <> rowNum Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = "C column value is duplicated"
|
||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
' Check D and E column in the cache
|
||||
If z1Cache Is Nothing Then Call RefreshZ1Cache
|
||||
If z1Cache Is Nothing Then Exit Sub
|
||||
|
||||
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
|
||||
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
|
||||
|
||||
If Not z1Cache.Exists(dValue) Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = "D column does not exist."
|
||||
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
Else
|
||||
Dim valueArray As Variant
|
||||
valueArray = z1Cache(dValue)
|
||||
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = "Invalid reference data for D column."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim expectedEValue As String
|
||||
expectedEValue = Trim(CStr(valueArray(0)))
|
||||
|
||||
If eValue <> expectedEValue Then
|
||||
ws.Cells(rowNum, ERROR_COL).Value = "E column does not match reference data."
|
||||
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next r
|
||||
|
||||
' Validation passed - clear error
|
||||
ws.Cells(rowNum, 19).ClearContents
|
||||
ws.Cells(rowNum, ERROR_COL).ClearContents
|
||||
End Sub
|
||||
|
||||
|
||||
Sub validateButton()
|
||||
Dim ws As Worksheet
|
||||
Dim lastRow As Long
|
||||
Dim r As Long
|
||||
Dim errorCount As Long
|
||||
Dim lastDataRow As Long, r As Long, errorCount As Long
|
||||
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
|
||||
|
||||
Set ws = Me
|
||||
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
|
||||
|
||||
If lastRow < 7 Then
|
||||
If lastDataRow < 7 Then
|
||||
MsgBox "No data found.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
errorCount = 0
|
||||
For r = 7 To lastRow
|
||||
Call validate(ws, r)
|
||||
If Trim(ws.Cells(r, 19).Value) <> "" Then
|
||||
For r = 7 To lastDataRow
|
||||
Validate r, lastDataRow
|
||||
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
Next r
|
||||
@@ -242,8 +235,8 @@ Sub M1_Export()
|
||||
Dim r As Long, errorCount As Long
|
||||
For r = 7 To lastDataRow
|
||||
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||
Call validate(ws, r)
|
||||
If Trim(ws.Cells(r, 19).Value) <> "" Then
|
||||
Call validate(r, lastDataRow)
|
||||
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
' ====== Constants ======
|
||||
Const START_COL As Long = 3
|
||||
Const END_COL As Long = 9
|
||||
Const ERROR_COL As Long = 2
|
||||
|
||||
' ====== Function ======
|
||||
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
@@ -149,7 +150,7 @@ Sub Z1_validateButton()
|
||||
errorCount = 0
|
||||
For r = 7 To lastDataRow
|
||||
Validate r
|
||||
If Trim(Cells(r, 2).Value) <> "" Then
|
||||
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
Next r
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
' ====== Constants ======
|
||||
Const START_COL As Long = 3
|
||||
Const END_COL As Long = 7
|
||||
Const ERROR_COL As Long = 2
|
||||
|
||||
' ====== Function ======
|
||||
Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
@@ -133,7 +134,7 @@ Sub Z2_validateButton()
|
||||
errorCount = 0
|
||||
For r = 7 To lastDataRow
|
||||
Validate r
|
||||
If Trim(Cells(r, 2).Value) <> "" Then
|
||||
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
Next r
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
' ====== Constants ======
|
||||
Const START_COL As Long = 3
|
||||
Const END_COL As Long = 8
|
||||
Const ERROR_COL As Long = 2
|
||||
|
||||
' ====== Function ======
|
||||
Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
@@ -141,7 +142,7 @@ Sub Z3_validateButton()
|
||||
errorCount = 0
|
||||
For r = 7 To lastDataRow
|
||||
Validate r
|
||||
If Trim(Cells(r, 2).Value) <> "" Then
|
||||
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
|
||||
errorCount = errorCount + 1
|
||||
End If
|
||||
Next r
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user