Global Variables and Constants

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
 
J

Jim Cone

First thing I saw was the brackets [ and ] in the range call outs.
Remove all of those and try your code again.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)


"Karen53"
wrote in message
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
 
D

Dave Peterson

I didn't look at the whole code, but this kind of code:
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
will fail if R1 isn't found.

I'd use:
dim FoundCell as range
set foundcell = r2.find(r1.value, lookat:=xlwhole, .....)
if foundcell is nothing then
'what should myRow be???
else
myrow = foundcell.row
end if

A couple of ps's:

It's a good idea to pass all the parms to the .find statement. Excel and VBA
share the same settings. If you don't specify all of the parms, then you'll be
inheriting the settings from the last Find (either in VBA or by the user). This
can be a difficult to debug.

And ([UserNameCol]) in:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
doesn't need the parens or the brackets:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
or
Set R1 = wbkNew.Sheets(wsNew.Name).cells(ictr, UserNameCol)


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
Click to expand...
 
K

Karen53

Thank you both. I will try it out tomorrow at work.

Dave, thank you for the behind the scenes possibilty with find.
--
Thanks for your help.
Karen53


Dave Peterson said:
I didn't look at the whole code, but this kind of code:
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
will fail if R1 isn't found.

I'd use:
dim FoundCell as range
set foundcell = r2.find(r1.value, lookat:=xlwhole, .....)
if foundcell is nothing then
'what should myRow be???
else
myrow = foundcell.row
end if

A couple of ps's:

It's a good idea to pass all the parms to the .find statement. Excel and VBA
share the same settings. If you don't specify all of the parms, then you'll be
inheriting the settings from the last Find (either in VBA or by the user). This
can be a difficult to debug.

And ([UserNameCol]) in:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
doesn't need the parens or the brackets:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
or
Set R1 = wbkNew.Sheets(wsNew.Name).cells(ictr, UserNameCol)


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
Click to expand...
Click to expand...
 
K

Karen53

Yay!! Thank you, Dave.

A question...What do the Parens and brackets do?
--
Thanks for your help.
Karen53


Dave Peterson said:
I didn't look at the whole code, but this kind of code:
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
will fail if R1 isn't found.

I'd use:
dim FoundCell as range
set foundcell = r2.find(r1.value, lookat:=xlwhole, .....)
if foundcell is nothing then
'what should myRow be???
else
myrow = foundcell.row
end if

A couple of ps's:

It's a good idea to pass all the parms to the .find statement. Excel and VBA
share the same settings. If you don't specify all of the parms, then you'll be
inheriting the settings from the last Find (either in VBA or by the user). This
can be a difficult to debug.

And ([UserNameCol]) in:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
doesn't need the parens or the brackets:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
or
Set R1 = wbkNew.Sheets(wsNew.Name).cells(ictr, UserNameCol)


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
Click to expand...
Click to expand...
 
D

Dave Peterson

The ()'s are used mostly for human's reading -- removing ambiguity.

Excel will calculate this following its own rules of precedence.
msgbox 1 + 3 / 6

But it may not be what you intend (if you wanted this):
msgbox (1 + 3) /6

Personally, I don't like to leave these kinds of things to my memory.

I'd specify:
msgbox 1 + (3 / 6)

======
The []'s are a shorthand that does the same thing as
application.evaluate()

It essentially uses excel's calculation engine to figure out the value inside
the []'s.


Yay!! Thank you, Dave.

A question...What do the Parens and brackets do?
--
Thanks for your help.
Karen53

Dave Peterson said:
I didn't look at the whole code, but this kind of code:
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
will fail if R1 isn't found.

I'd use:
dim FoundCell as range
set foundcell = r2.find(r1.value, lookat:=xlwhole, .....)
if foundcell is nothing then
'what should myRow be???
else
myrow = foundcell.row
end if

A couple of ps's:

It's a good idea to pass all the parms to the .find statement. Excel and VBA
share the same settings. If you don't specify all of the parms, then you'll be
inheriting the settings from the last Find (either in VBA or by the user). This
can be a difficult to debug.

And ([UserNameCol]) in:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
doesn't need the parens or the brackets:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
or
Set R1 = wbkNew.Sheets(wsNew.Name).cells(ictr, UserNameCol)


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
Click to expand...
Click to expand...
Click to expand...
 
K

Karen53

Dave,

I had this working except I wasn't getting accurate results because I wasn't
finding the multiple hits for the same username. I've added FindNext but now
it errors out because it looses the value of the global variable wsOld within
the findnext loop. It says 'automation error'. What have I done wrong?

Sub AllFolderFiles(iCtr, ThisGroupType, ThisUsername, ThisGroupName,
ThisServerName)

Dim TheFile As String
Dim MyPath As String
Dim ThisWkSheet As Worksheet
Dim rngFind As Range 'value to find
Dim rngWhere As Range 'where to look
Dim MyRow As Long
Dim OldLusedrow As Long
Dim MatchFound As Boolean
Dim MatchGroup As Boolean
Dim MatchServer As Boolean
Dim errLusedrow As Long
Dim FoundCell As Range
Dim SafetyCk As String
Dim FirstAddress As String 'keep track of first found for findnext
Dim rngFound As Range

MatchFound = False

ChDir OldJustPath
TheFile = Dir("*.xls")

Do While TheFile <> ""
Set wbkOld = Workbooks.Open(OldJustPath & "\" & TheFile)
Debug.Print "Starting "; 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 "Start wsOld " & wsOld.Name

If MatchFound = False Then
Debug.Print "Start MatchFound false " & wbkOld.FullName

'check for UserName match
Set rngFind =
wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
Set rngWhere =
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & "2:" & UserNameCol &
OldLusedrow)

Set FoundCell = rngWhere.Find(rngFind.Value,
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
MatchByte:=False, SearchFormat:=False)

If FoundCell Is Nothing Then
GoTo NotFound
Else
MyRow = FoundCell.Row
Debug.Print "MyRow " & MyRow
Debug.Print "FoundCell " & wbkOld.FullName

End If

'save the first found address
FirstAddress = FoundCell.Address

'look for more rows of same name
Do
Set rngFound = FoundCell.FindNext(FoundCell)
If rngFound Is Nothing Then
GoTo NotFound
Else
MyRow = rngFound.Row

If ThisGroupType <> "Global Group" Then

'check for groupname match
If ThisGroupName =
wbkOld.Sheets(wsOld.Name).Range(GroupNameCol & MyRow).Value Then
MatchGroup = True
End If

'check for ServerName match
If ThisServerName =
wbkOld.Sheets(wsOld.Name).Range(ServerNameCol & MyRow).Value Then
MatchServer = True
End If

If MatchGroup = True And MatchServer
= True Then
Call CopyToFrom(iCtr, MyRow,
ThisGroupType)
MatchFound = True
Debug.Print "Local MatchFound " & wbkOld.FullName
GoTo FoundIt
End If
End If 'end local match


If ThisGroupType = "Global Group" Then

'check for groupname match
If ThisGroupName =
wbkOld.Sheets(wsOld.Name).Range(GroupNameCol & MyRow).Value Then
MatchFound = True
Call CopyToFrom(iCtr, MyRow,
ThisGroupType)

GoTo FoundIt
End If
End If 'end global match

End If ' if rngFound

Loop Until rngFound Is Nothing Or rngFound.Address =
FirstAddress

End If 'MatchFound = False

NotFound:
Debug.Print "NotFound " & wbkOld.FullName

If MyRow > 0 Then
Debug.Print "ThisUserName " & ThisUsername & " ThisGroupName
" & ThisGroupName
Debug.Print "ictr " & iCtr & " ThisServerName " &
ThisServerName
Debug.Print "Old server name " &
wbkOld.Sheets(wsOld.Name).Range(ServerNameCol & MyRow).Value
Debug.Print "UserName " &
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & MyRow).Value & " MyRow " & MyRow
End If

If iCtr = 252 Then
Debug.Assert (False)
End If

Set rngFind = Nothing
Set rngWhere = Nothing

Next 'each worksheet

wbkOld.Close
TheFile = Dir

Loop 'Do While

FoundIt:
Debug.Print "FoundIt " & wbkOld.FullName

Debug.Print "ThisUserName " & ThisUsername & " ThisGroupName " &
ThisGroupName
Debug.Print "ictr " & iCtr & " ThisServerName " & ThisServerName
Debug.Print "Old server name " &
wbkOld.Sheets(wsOld.Name).Range(ServerNameCol & MyRow).Value
Debug.Print "UserName " &
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & MyRow).Value & " MyRow " & MyRow

If iCtr = 252 Then
Debug.Assert (False)
End If

If MatchFound = False Then

Set rngFind = Nothing
Set rngWhere = Nothing

With ThisWorkbook
errLusedrow = shtErrors.Cells(Rows.Count,
UserNameCol).End(xlUp).Row + 1
End With

Set rngFind = wbkNew.Sheets(wsNew.Name).Range(iCtr & ":" & iCtr)
'Copy From
Set rngWhere = ThisWorkbook.Sheets("Errors").Range(errLusedrow & ":"
& errLusedrow) 'Copy To
rngWhere.Value = rngFind.Value

Set rngFind = Nothing
Set rngWhere = Nothing

'save SafetyCheck (Where original user was found)
SafetyCk = wbkNew.Name & " " & wsNew.Name & " Row " & iCtr
Set rngWhere = ThisWorkbook.Sheets("Errors").Range(SafetyChkCol &
errLusedrow)
rngWhere.Value = SafetyCk

End If

If MatchFound = True Then
MatchFound = False
wbkOld.Close
End If

End Sub

--
Thanks for your help.
Karen53


Dave Peterson said:
The ()'s are used mostly for human's reading -- removing ambiguity.

Excel will calculate this following its own rules of precedence.
msgbox 1 + 3 / 6

But it may not be what you intend (if you wanted this):
msgbox (1 + 3) /6

Personally, I don't like to leave these kinds of things to my memory.

I'd specify:
msgbox 1 + (3 / 6)

======
The []'s are a shorthand that does the same thing as
application.evaluate()

It essentially uses excel's calculation engine to figure out the value inside
the []'s.


Yay!! Thank you, Dave.

A question...What do the Parens and brackets do?
--
Thanks for your help.
Karen53

Dave Peterson said:
I didn't look at the whole code, but this kind of code:
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
will fail if R1 isn't found.

I'd use:
dim FoundCell as range
set foundcell = r2.find(r1.value, lookat:=xlwhole, .....)
if foundcell is nothing then
'what should myRow be???
else
myrow = foundcell.row
end if

A couple of ps's:

It's a good idea to pass all the parms to the .find statement. Excel and VBA
share the same settings. If you don't specify all of the parms, then you'll be
inheriting the settings from the last Find (either in VBA or by the user). This
can be a difficult to debug.

And ([UserNameCol]) in:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
doesn't need the parens or the brackets:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
or
Set R1 = wbkNew.Sheets(wsNew.Name).cells(ictr, UserNameCol)



Karen53 wrote:

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
Click to expand...
Click to expand...
Click to expand...
 
D

Dave Peterson

First, I'm not sure what you're doing or how you're losing the value in that
variable.

But this looks funny to me:

Do
Set rngFound = FoundCell.FindNext(FoundCell)
If rngFound Is Nothing Then
GoTo NotFound
Else
MyRow = rngFound.Row

If ThisGroupType <> "Global Group" Then

'check for groupname match
If ThisGroupName = wbkOld.Sheets(wsOld.Name) _
.Range(GroupNameCol & MyRow).Value Then
MatchGroup = True
End If

'check for ServerName match
If ThisServerName = wbkOld.Sheets(wsOld.Name) _
.Range(ServerNameCol & MyRow).Value Then
MatchServer = True
End If

If MatchGroup = True And MatchServer = True Then
Call CopyToFrom(iCtr, MyRow, ThisGroupType)
MatchFound = True
Debug.Print "Local MatchFound " & wbkOld.FullName
GoTo FoundIt
End If
End If 'end local match


If ThisGroupType = "Global Group" Then

'check for groupname match
If ThisGroupName = wbkOld.Sheets(wsOld.Name).Range(GroupNameCol &
MyRow).Value Then
MatchFound = True
Call CopyToFrom(iCtr, MyRow, ThisGroupType)

GoTo FoundIt
End If
End If 'end global match

End If ' if rngFound

Loop Until rngFound Is Nothing Or rngFound.Address = FirstAddress

=======
The loop starts off with a .findnext() statement. Usually, that .findnext is at
the bottom of the loop.

You do a .find before the loop. Check the results, save the firstaddress (if it
was found).

Then the loop starts.

You do what you need and finish up with a check to see if you should get out of
the loop:

Do

MyRow = rngFound.Row

If ThisGroupType <> "Global Group" Then

'check for groupname match
If ThisGroupName = wbkOld.Sheets(wsOld.Name) _
.Range(GroupNameCol & MyRow).Value Then
MatchGroup = True
End If

'check for ServerName match
If ThisServerName = wbkOld.Sheets(wsOld.Name) _
.Range(ServerNameCol & MyRow).Value Then
MatchServer = True
End If

If MatchGroup = True And MatchServer = True Then
Call CopyToFrom(iCtr, MyRow, ThisGroupType)
MatchFound = True
Debug.Print "Local MatchFound " & wbkOld.FullName
GoTo FoundIt
End If
End If 'end local match


If ThisGroupType = "Global Group" Then

'check for groupname match
If ThisGroupName = wbkOld.Sheets(wsOld.Name) _
.Range(GroupNameCol & MyRow).Value Then
MatchFound = True
Call CopyToFrom(iCtr, MyRow, ThisGroupType)

GoTo FoundIt
End If
End If 'end global match

Set FoundCell = .FindNext(after:=FoundCell)

If FoundCell Is Nothing Then
Exit Do
End If

If FoundCell.Address = FirstAddress Then
Exit Do
End If

Loop

I find it easier to understand if I use my own exit lines.

If FoundCell Is Nothing Then
Exit Do
End If

If FoundCell.Address = FirstAddress Then
Exit Do
End If

And if you actually change the cell that held the value that you were looking
for, you may not find another cell that contains that string.

(There's a small bug in VBA's help for .findnext() in some versions of excel.
It changes the value and causes the value not to be found. So FoundCell.address
won't work. Other versions, just change the color of the cell. That sample
code would work (but is dangerous to me!).)



Dave,

I had this working except I wasn't getting accurate results because I wasn't
finding the multiple hits for the same username. I've added FindNext but now
it errors out because it looses the value of the global variable wsOld within
the findnext loop. It says 'automation error'. What have I done wrong?

Sub AllFolderFiles(iCtr, ThisGroupType, ThisUsername, ThisGroupName,
ThisServerName)

Dim TheFile As String
Dim MyPath As String
Dim ThisWkSheet As Worksheet
Dim rngFind As Range 'value to find
Dim rngWhere As Range 'where to look
Dim MyRow As Long
Dim OldLusedrow As Long
Dim MatchFound As Boolean
Dim MatchGroup As Boolean
Dim MatchServer As Boolean
Dim errLusedrow As Long
Dim FoundCell As Range
Dim SafetyCk As String
Dim FirstAddress As String 'keep track of first found for findnext
Dim rngFound As Range

MatchFound = False

ChDir OldJustPath
TheFile = Dir("*.xls")

Do While TheFile <> ""
Set wbkOld = Workbooks.Open(OldJustPath & "\" & TheFile)
Debug.Print "Starting "; 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 "Start wsOld " & wsOld.Name

If MatchFound = False Then
Debug.Print "Start MatchFound false " & wbkOld.FullName

'check for UserName match
Set rngFind =
wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
Set rngWhere =
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & "2:" & UserNameCol &
OldLusedrow)

Set FoundCell = rngWhere.Find(rngFind.Value,
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
MatchByte:=False, SearchFormat:=False)

If FoundCell Is Nothing Then
GoTo NotFound
Else
MyRow = FoundCell.Row
Debug.Print "MyRow " & MyRow
Debug.Print "FoundCell " & wbkOld.FullName

End If

'save the first found address
FirstAddress = FoundCell.Address

'look for more rows of same name
Do
Set rngFound = FoundCell.FindNext(FoundCell)
If rngFound Is Nothing Then
GoTo NotFound
Else
MyRow = rngFound.Row

If ThisGroupType <> "Global Group" Then

'check for groupname match
If ThisGroupName =
wbkOld.Sheets(wsOld.Name).Range(GroupNameCol & MyRow).Value Then
MatchGroup = True
End If

'check for ServerName match
If ThisServerName =
wbkOld.Sheets(wsOld.Name).Range(ServerNameCol & MyRow).Value Then
MatchServer = True
End If

If MatchGroup = True And MatchServer
= True Then
Call CopyToFrom(iCtr, MyRow,
ThisGroupType)
MatchFound = True
Debug.Print "Local MatchFound " & wbkOld.FullName
GoTo FoundIt
End If
End If 'end local match


If ThisGroupType = "Global Group" Then

'check for groupname match
If ThisGroupName =
wbkOld.Sheets(wsOld.Name).Range(GroupNameCol & MyRow).Value Then
MatchFound = True
Call CopyToFrom(iCtr, MyRow,
ThisGroupType)

GoTo FoundIt
End If
End If 'end global match

End If ' if rngFound

Loop Until rngFound Is Nothing Or rngFound.Address =
FirstAddress

End If 'MatchFound = False

NotFound:
Debug.Print "NotFound " & wbkOld.FullName

If MyRow > 0 Then
Debug.Print "ThisUserName " & ThisUsername & " ThisGroupName
" & ThisGroupName
Debug.Print "ictr " & iCtr & " ThisServerName " &
ThisServerName
Debug.Print "Old server name " &
wbkOld.Sheets(wsOld.Name).Range(ServerNameCol & MyRow).Value
Debug.Print "UserName " &
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & MyRow).Value & " MyRow " & MyRow
End If

If iCtr = 252 Then
Debug.Assert (False)
End If

Set rngFind = Nothing
Set rngWhere = Nothing

Next 'each worksheet

wbkOld.Close
TheFile = Dir

Loop 'Do While

FoundIt:
Debug.Print "FoundIt " & wbkOld.FullName

Debug.Print "ThisUserName " & ThisUsername & " ThisGroupName " &
ThisGroupName
Debug.Print "ictr " & iCtr & " ThisServerName " & ThisServerName
Debug.Print "Old server name " &
wbkOld.Sheets(wsOld.Name).Range(ServerNameCol & MyRow).Value
Debug.Print "UserName " &
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & MyRow).Value & " MyRow " & MyRow

If iCtr = 252 Then
Debug.Assert (False)
End If

If MatchFound = False Then

Set rngFind = Nothing
Set rngWhere = Nothing

With ThisWorkbook
errLusedrow = shtErrors.Cells(Rows.Count,
UserNameCol).End(xlUp).Row + 1
End With

Set rngFind = wbkNew.Sheets(wsNew.Name).Range(iCtr & ":" & iCtr)
'Copy From
Set rngWhere = ThisWorkbook.Sheets("Errors").Range(errLusedrow & ":"
& errLusedrow) 'Copy To
rngWhere.Value = rngFind.Value

Set rngFind = Nothing
Set rngWhere = Nothing

'save SafetyCheck (Where original user was found)
SafetyCk = wbkNew.Name & " " & wsNew.Name & " Row " & iCtr
Set rngWhere = ThisWorkbook.Sheets("Errors").Range(SafetyChkCol &
errLusedrow)
rngWhere.Value = SafetyCk

End If

If MatchFound = True Then
MatchFound = False
wbkOld.Close
End If

End Sub

--
Thanks for your help.
Karen53

Dave Peterson said:
The ()'s are used mostly for human's reading -- removing ambiguity.

Excel will calculate this following its own rules of precedence.
msgbox 1 + 3 / 6

But it may not be what you intend (if you wanted this):
msgbox (1 + 3) /6

Personally, I don't like to leave these kinds of things to my memory.

I'd specify:
msgbox 1 + (3 / 6)

======
The []'s are a shorthand that does the same thing as
application.evaluate()

It essentially uses excel's calculation engine to figure out the value inside
the []'s.


Yay!! Thank you, Dave.

A question...What do the Parens and brackets do?
--
Thanks for your help.
Karen53

:

I didn't look at the whole code, but this kind of code:
MyRow = R2.Find(R1, LookAt:=xlWhole).Row
will fail if R1 isn't found.

I'd use:
dim FoundCell as range
set foundcell = r2.find(r1.value, lookat:=xlwhole, .....)
if foundcell is nothing then
'what should myRow be???
else
myrow = foundcell.row
end if

A couple of ps's:

It's a good idea to pass all the parms to the .find statement. Excel and VBA
share the same settings. If you don't specify all of the parms, then you'll be
inheriting the settings from the last Find (either in VBA or by the user). This
can be a difficult to debug.

And ([UserNameCol]) in:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(([UserNameCol]) & iCtr)
doesn't need the parens or the brackets:
Set R1 = wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
or
Set R1 = wbkNew.Sheets(wsNew.Name).cells(ictr, UserNameCol)



Karen53 wrote:

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
Click to expand...
Click to expand...
Click to expand...
 
K

Karen53

Thank you, Dave.

I think I've missed something though. I get an error on the
..FindNext(after:=FoundCell). What have I left out?

If MatchFound = False Then

'check for UserName match
Set rngFind =
wbkNew.Sheets(wsNew.Name).Range(UserNameCol & iCtr)
Set rngWhere =
wbkOld.Sheets(wsOld.Name).Range(UserNameCol & "2:" & UserNameCol &
OldLusedrow)

Set FoundCell = rngWhere.Find(rngFind.Value,
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
MatchByte:=False, SearchFormat:=False)

If FoundCell Is Nothing Then
GoTo NotFound
Else

'save the first found address
FirstAddress = FoundCell.Address
MyRow = FoundCell.Row

Do

Call ChkforMatch(iCtr, MyRow, ThisGroupType,
ThisGroupName, ThisServerName, MatchFound)

'look for more rows of same name
Set FoundCell = .FindNext(after:=FoundCell)

If FoundCell Is Nothing Then
GoTo NotFound
Else
MyRow = FoundCell.Row
End If ' if FoundCell

If FoundCell Is Nothing Then
Exit Do
End If

If FoundCell.Address = FirstAddress Then
Exit Do
End If
Loop

End If 'foundcell
End If 'MatchFound = False
 
K

Karen53

Dave, I got it.

'look for more rows of same name
Set FoundCell = FoundCell.FindNext(after:=FoundCell)

The trouble is, I'm still not getting the additional hits for the usernames.
Names I know are matches are appearing as not matching. My user in is
MyRows 185 and 186. 186 is the match but it doesn't get there. Only 185
shows in the debug. It moves on to the next workbook. I tried removing Goto
NotFound and changing it to Exit Do but have the same result.
 
D

Dave Peterson

I truncated the code too much in the last example. (And I hope it's not too
much in this one!)

Option Explicit
Sub testme()

Dim RngFind As Range
Dim RngWhere As Range
Dim FoundCell As Range
Dim WbkNew As Workbook
Dim WSNew As Worksheet
Dim WbkOld As Workbook
Dim WSOld As Worksheet
Dim FirstAddress As String
Dim myRow As Long

Dim UserNameCol As String
Dim OldLUsedRow As Long
Dim iCtr As Long

UserNameCol = "a"
OldLUsedRow = 99
iCtr = 7

Set WbkOld = Workbooks("book5.xls")
Set WbkNew = Workbooks("book4.xls")

Set WSNew = WbkNew.Worksheets("sheet1")
Set WSOld = WbkOld.Worksheets("sheet1")

'check for UserName match
'you can refer to the wsnew and wsold directly.
'you don't need wbknew.worksheets(wsnew.name)

'The only time you'd want that kind of syntax is when wsnew isn't
'part of wbknew, but I bet you're not doing that here

Set RngFind = WSNew.Range(UserNameCol & iCtr)
Set RngWhere = WSOld.Range(UserNameCol & "2:" & UserNameCol & OldLUsedRow)

With RngWhere
Set FoundCell = RngWhere.Find(RngFind.Value, _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
MatchByte:=False, _
SearchFormat:=False)

If FoundCell Is Nothing Then
GoTo NotFound:
Else

'save the first found address
FirstAddress = FoundCell.Address

Do
myRow = FoundCell.Row

'Call ChkforMatch(iCtr, _
MyRow, _
ThisGroupType, _
ThisGroupName, _
ThisServerName, _
MatchFound)

'I used this to make sure it worked
MsgBox FoundCell.Address(external:=True)

'look for more rows of same name
Set FoundCell = .FindNext(after:=FoundCell)

'don't do any more stuff here.
'it'll get done at the top of the loop

If FoundCell Is Nothing Then
Exit Do
End If

If FoundCell.Address = FirstAddress Then
Exit Do
End If
Loop
End If
End With

Exit Sub

NotFound:
MsgBox "not found!"

End Sub
 
D

Dave Peterson

Our messages crossed in the ether!

I'd skinny down the code to just get one version of the loop to work. And you
may want to look at that earlier reply.
 
D

Dave Peterson

I'm not sure what you mean.

You could have used:
Set FoundCell = RngWhere.Find(trim(RngFind.Value), _

or
if foundcell is nothing then
'do nothing
else
somestring = trim(foundcell.value)
end if

or maybe you could have used:
lookat:=xlPart,
instead of
lookat:=xlWhole,
 
K

Karen53

Thanks, Dave. That's exactly what I meant. xlPart wouldn't work though as
many are very similar.

This part is up and running. Again, thank you.
 
D

Dave Peterson

Whew!
<vbg>
Thanks, Dave. That's exactly what I meant. xlPart wouldn't work though as
many are very similar.

This part is up and running. Again, thank you.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Global Variables 12
Range of Object Worksheet failed 2
Copy from one workbook to another 4
Error in Macro 4

Top