K
Karen53
Hi,
I'm having trouble with this. I have global constant variables and global
variables.
Option Explicit
Public Const CIONameCol As String = "A"
Public Const ServerNameCol As String = "B"
Public Const GroupNameCol As String = "C"
Public Const UserNameCol As String = "D"
Public Const FullNameCol As String = "E"
Public Const UserDomainCol As String = "F"
Public Const GroupTypeCol As String = "G"
Public Const RecertifyCol As String = "H"
Public Const ApprovingManagerCol As String = "I"
Public Const SafetyChkCol As String = "J"
Public wsNew As Worksheet
Public wsOld As Worksheet
Public wbkOld As Workbook
Public wbkNew As Workbook
Public OldJustPath As String
Public NewJustPath As String
I have a procedure which opens the wbkNew, sets it and determines the wbkOld
directory. That procedure then calls this procedure. It errors at the
' MyRow = R2.Find(R1, LookAt:=xlWhole).Row' line telling me 'Object
variable or With block not set. I have tried resetting wbkNew within this
procedure as well as placing the line in a 'with wbkNew - end with. Neither
made any difference. What's wrong?
Sub AllFolderFiles( iCtr, ThisGroupType, ThisUsername, ThisGroupName,
ThisServerName)
Dim TheFile As String
Dim MyPath As String
Dim ThisWkSheet As Worksheet
Dim R1 As Range 'value to find
Dim R2 As Range 'where to look
Dim MyRow As Long
Dim rngCopyTo As Range
Dim rngCopyFrom As Range
Dim OldLusedrow As Long
Dim MatchFound as Boolean
Dim MatchUser As Boolean
Dim MatchGroup As Boolean
Dim MatchServer As Boolean
Dim SafetyCk As String
Dim errLusedrow As Long
MatchFound = False
ChDir OldJustPath
TheFile = Dir("*.xls")
Do While TheFile <> ""
Set wbkOld = Workbooks.Open(OldJustPath & "\" & TheFile)
'MsgBox wbkOld.FullName
For Each ThisWkSheet In wbkOld.Worksheets
Set wsOld = ThisWkSheet
'get the last used row on this sheet
OldLusedrow = wsOld.Cells(Rows.Count,
([UserNameCol])).End(xlUp).Row
Debug.Print "wsOld " & wsOld.Name
Debug.Print "ThisWkSheet " & ThisWkSheet.Name
Debug.Print "OldLusedrow " & OldLusedrow
Debug.Print "MyRow " & MyRow
' Debug.Assert RowCtr < 10
If MatchFound = False Then
'check for UserName match
Set R1 =
wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
Set R2 =
wbkOld.Sheets(wsOld.Name).Range(([UserNameCol]) & "2:" & ([UserNameCol]) &
OldLusedrow)
On Error GoTo NotFound
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
On Error GoTo 0
Debug.Print "MyRow " & MyRow
MatchUser = True
Set R1 = Nothing
Set R2 = Nothing
'check for groupname match
If ThisGroupName =
wbkOld.Sheets(wsOld.Name).Range(([GroupNameCol]) & MyRow) Then
MatchGroup = True
End If
If ThisGroupType = "Local Group" Then
'check for ServerName match
If ThisServerName =
wbkOld.Sheets(wsOld.Name).Range(([ServerCol]) & MyRow) Then
MatchServer = True
End If
If MatchUser = True Then
If MatchGroup = True Then
If MatchServer = True Then
MatchFound = True
'copy CIOName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([CIONameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([CIONameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'copy FullName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([FullNameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([FullNameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'save SafetyCheck (Where match was
found)
SafetyCk = wbkOld.Name & " " &
wsOld.Name & " Row " & MyRow
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([SafetyChkCol]) & iCtr)
rngCopyTo.Value = SafetyCk
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
GoTo FoundIt
End If 'MatchServer
MatchServer = False
End If 'MatchGroup
MatchGroup = False
End If 'MatchUser
End If 'Local Group
If ThisGroupType <> "Local Group" Then
If MatchUser = True Then
If MatchGroup = True Then
MatchFound = True
'copy CIOName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([CIONameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([CIONameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'copy FullName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([FullNameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([FullNameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'save SafetyCheck (Where match was
found)
SafetyCk = wbkOld.Name & " " &
wsOld.Name & " Row " & MyRow
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([SafetyChkCol]) & iCtr)
rngCopyTo.Value = SafetyCk
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
GoTo FoundIt
End If 'MatchGroup
MatchGroup = False
End If 'MatchUser
MatchUser = False
End If 'group type not local
End If 'MatchFound = False
NotFound:
Next 'each worksheet
wbkOld.Close
TheFile = Dir
Loop 'Do While
FoundIt:
'reset found indicators
MatchUser = False
MatchGroup = False
MatchServer = False
If MatchFound = False Then
With ThisWorkbook
errLusedrow = shtErrors.Cells(Rows.Count,
([UserNameCol])).End(xlUp).Row + 1
End With
Set rngCopyFrom = wbkNew.Sheets(wsNew.Name).Range(iCtr)
Set rngCopyTo = ThisWorkbook.Sheets("Errors").Range(errLusedrow)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
End If
If MatchFound = True Then
MatchFound = False
wbkOld.Close
End If
End Sub
I'm having trouble with this. I have global constant variables and global
variables.
Option Explicit
Public Const CIONameCol As String = "A"
Public Const ServerNameCol As String = "B"
Public Const GroupNameCol As String = "C"
Public Const UserNameCol As String = "D"
Public Const FullNameCol As String = "E"
Public Const UserDomainCol As String = "F"
Public Const GroupTypeCol As String = "G"
Public Const RecertifyCol As String = "H"
Public Const ApprovingManagerCol As String = "I"
Public Const SafetyChkCol As String = "J"
Public wsNew As Worksheet
Public wsOld As Worksheet
Public wbkOld As Workbook
Public wbkNew As Workbook
Public OldJustPath As String
Public NewJustPath As String
I have a procedure which opens the wbkNew, sets it and determines the wbkOld
directory. That procedure then calls this procedure. It errors at the
' MyRow = R2.Find(R1, LookAt:=xlWhole).Row' line telling me 'Object
variable or With block not set. I have tried resetting wbkNew within this
procedure as well as placing the line in a 'with wbkNew - end with. Neither
made any difference. What's wrong?
Sub AllFolderFiles( iCtr, ThisGroupType, ThisUsername, ThisGroupName,
ThisServerName)
Dim TheFile As String
Dim MyPath As String
Dim ThisWkSheet As Worksheet
Dim R1 As Range 'value to find
Dim R2 As Range 'where to look
Dim MyRow As Long
Dim rngCopyTo As Range
Dim rngCopyFrom As Range
Dim OldLusedrow As Long
Dim MatchFound as Boolean
Dim MatchUser As Boolean
Dim MatchGroup As Boolean
Dim MatchServer As Boolean
Dim SafetyCk As String
Dim errLusedrow As Long
MatchFound = False
ChDir OldJustPath
TheFile = Dir("*.xls")
Do While TheFile <> ""
Set wbkOld = Workbooks.Open(OldJustPath & "\" & TheFile)
'MsgBox wbkOld.FullName
For Each ThisWkSheet In wbkOld.Worksheets
Set wsOld = ThisWkSheet
'get the last used row on this sheet
OldLusedrow = wsOld.Cells(Rows.Count,
([UserNameCol])).End(xlUp).Row
Debug.Print "wsOld " & wsOld.Name
Debug.Print "ThisWkSheet " & ThisWkSheet.Name
Debug.Print "OldLusedrow " & OldLusedrow
Debug.Print "MyRow " & MyRow
' Debug.Assert RowCtr < 10
If MatchFound = False Then
'check for UserName match
Set R1 =
wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
Set R2 =
wbkOld.Sheets(wsOld.Name).Range(([UserNameCol]) & "2:" & ([UserNameCol]) &
OldLusedrow)
On Error GoTo NotFound
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
On Error GoTo 0
Debug.Print "MyRow " & MyRow
MatchUser = True
Set R1 = Nothing
Set R2 = Nothing
'check for groupname match
If ThisGroupName =
wbkOld.Sheets(wsOld.Name).Range(([GroupNameCol]) & MyRow) Then
MatchGroup = True
End If
If ThisGroupType = "Local Group" Then
'check for ServerName match
If ThisServerName =
wbkOld.Sheets(wsOld.Name).Range(([ServerCol]) & MyRow) Then
MatchServer = True
End If
If MatchUser = True Then
If MatchGroup = True Then
If MatchServer = True Then
MatchFound = True
'copy CIOName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([CIONameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([CIONameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'copy FullName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([FullNameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([FullNameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'save SafetyCheck (Where match was
found)
SafetyCk = wbkOld.Name & " " &
wsOld.Name & " Row " & MyRow
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([SafetyChkCol]) & iCtr)
rngCopyTo.Value = SafetyCk
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
GoTo FoundIt
End If 'MatchServer
MatchServer = False
End If 'MatchGroup
MatchGroup = False
End If 'MatchUser
End If 'Local Group
If ThisGroupType <> "Local Group" Then
If MatchUser = True Then
If MatchGroup = True Then
MatchFound = True
'copy CIOName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([CIONameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([CIONameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'copy FullName
Set rngCopyFrom =
wbkOld.Sheets(wsOld.Name).Range(([FullNameCol]) & MyRow)
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([FullNameCol]) & iCtr)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
'save SafetyCheck (Where match was
found)
SafetyCk = wbkOld.Name & " " &
wsOld.Name & " Row " & MyRow
Set rngCopyTo =
wbkNew.Sheets(wsNew.Name).Range(([SafetyChkCol]) & iCtr)
rngCopyTo.Value = SafetyCk
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
GoTo FoundIt
End If 'MatchGroup
MatchGroup = False
End If 'MatchUser
MatchUser = False
End If 'group type not local
End If 'MatchFound = False
NotFound:
Next 'each worksheet
wbkOld.Close
TheFile = Dir
Loop 'Do While
FoundIt:
'reset found indicators
MatchUser = False
MatchGroup = False
MatchServer = False
If MatchFound = False Then
With ThisWorkbook
errLusedrow = shtErrors.Cells(Rows.Count,
([UserNameCol])).End(xlUp).Row + 1
End With
Set rngCopyFrom = wbkNew.Sheets(wsNew.Name).Range(iCtr)
Set rngCopyTo = ThisWorkbook.Sheets("Errors").Range(errLusedrow)
rngCopyTo.Value = rngCopyFrom.Value
Set rngCopyTo = Nothing
Set rngCopyFrom = Nothing
End If
If MatchFound = True Then
MatchFound = False
wbkOld.Close
End If
End Sub