James Snyder
Well-known Member
- Joined
- Jan 11, 2013
- Messages
- 618
Actually, I am sure I just don't know how it works well enough to make it work, but hope the expertise here will be enough to correct my misdirection.
I am using xlUnique to find unique values comparing two spreadsheets' keys. I copy the range from each sheet into a new worksheet to do the compare as a continuous range instead of the scattered areas of an AutoFilter. Here is the code:
To summarize, I successfully create the .FormatConditions collection, but cannot extract the values the .FormatCondition identifies.
I am using xlUnique to find unique values comparing two spreadsheets' keys. I copy the range from each sheet into a new worksheet to do the compare as a continuous range instead of the scattered areas of an AutoFilter. Here is the code:
Code:
Private Function DataCorrect(ByRef woWkBk As Workbook, _
ByRef ftpWkBk As Workbook, _
ByVal endColumn As Long, _
ByVal ftpMaxCol As Long, _
ByVal psidColumn As Long, _
ByRef exceptArray() As String, _
ByRef sendDate As String, _
ByVal errorSrc As String) As String
Dim ftpWkSht As Worksheet
Dim woWkSht As Worksheet
Dim newWkSht As Worksheet
Dim ftpRange As Range
Dim woWkShtRange As Range
Dim newRange As Range
Dim formatCond As FormatCondition
Dim ftpMax As Long
Dim rowMax As Long
Dim copyEnd As Long
Dim rng2Strt As Long
Dim rng2End As Long
If Not ftpWkBk Is Nothing Then
Set ftpWkSht = ftpWkBk.Sheets(1)
If Not ftpWkSht Is Nothing Then
With ftpWkSht
ftpMax = .UsedRange.Rows.count
Set ftpRange = .Range(.Cells(1, 1), .Cells(ftpMax, ftpMaxCol).End(xlUp))
Set newWkSht = Sheets.Add(After:=Sheets(1))
newWkSht.Name = tempShtName ' Visual only
Application.CutCopyMode = False ' Clear clipboard of copied data
' Copy FTP PSIDs to new sheet for unique value filtering
copyEnd = ftpMax - 1
.Range("A2:A" & ftpMax).Copy Destination:=newWkSht.Range("A1", "A" & copyEnd)
' Copy Work Orders PSIDs to new sheet - find new start and end for range
rng2Strt = copyEnd + 5
rng2End = rng2Strt + rowMax
woWkShtRange.Range("A2:A" & rowMax).Copy _
Destination:=newWkSht.Range("A" & rng2Strt, "A" & rng2End)
' Using both ranges, find any unique (not common to both) PSIDs
Set newRange = newWkSht.Range("A1:A" & copyEnd & ",A" & rng2Strt & ":A" & rng2End)
With newRange
.FormatConditions.AddUniqueValues
.FormatConditions(1).DupeUnique = xlUnique ' xlUniqueValues
If .FormatConditions.count > 0 Then ' <=== WORKS UP TO HERE, BUT CANNOT EXTRACT INFO
Set formatCond = .FormatConditions(1)
With .FormatConditions
For i = 1 To .count
' Other code dealing with handling the unique value
failReturn = WriteException(formatCond.item(i).Value, exceptArray, sendDate)
' Other code dealing with handling the unique value
Next i
End With ' .FormatConditions
Else
errString = "••• No mismatched rows in FTP/Work Orders •••"
failReturn = ProblemReport(errString, sendDate)
End If
End With ' newRange
End With
' Other code copying values from one DB to another
Application.DisplayAlerts = False ' Suppress "SaveAs" dialog box
Application.EnableEvents = False ' Suppress BeforeSave event
newRange.FormatConditions.Delete
newWkSht.Delete
ftpWkBk.Save
Application.EnableEvents = True
Application.DisplayAlerts = True
DataCorrect = "Success"
Else
' error checking removed for posting
End If
Else
' error checking removed for posting
End If
End Function