First off, thank you for taking the time to read this. I have searched fairly diligently through the forums for an answer to this question and tried everything that has been suggested (that I found), but still cannot get this code to work.
I have a somewhat lengthy bit of code, but the following snippet is the piece I am concerned with (and the only piece that breaks). Once Excel reaches the top line (below), it returns "Run-time Error '1004': Select method of Range class failed".
sht.Range(sht.Cells(k, LCol), sht.Cells(NumRows, LCol)).Select
Selection.Replace what:=TempLongName, Replacement:=TempShortName, lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
As you can see, I am trying to select a range on a sheet (Set sht = Sheets("CrystalReport")) starting at (k,LCol) and ending at (NumRows,LCol). Then a Find and Replace is performed.
I have retried the top line rewritten as
and as
Sheets("CrystalReport").Range(Sheets("CrystalReport").Cells(k, LCol), Sheets("CrystalReport").Cells(NumRows, LCol)).Select
Unfortunately, nothing is working.
FYI,
- I have debugged this and k = 2, LCol = 1, and NumRows = 1820. (not always, but for the first pass)
- It is not nested within another "With" statement.
- It is in a module NOT attached to a specific Workbook
There is an oddity! When debugging, I notice that the column of a completely different sheet ("CampusLocations") is selected (the very exact range that I want selected in the other sheet)! This Column includes a table (ListObject).
If it helps (and my code is horrible, so it may not), I have attached all the code up to this point.
Thank you again (and please don't hate me for my buggy coding skills),
Roy
Sub ShortenLocations(NumRows As Long) Dim LCol As Long
Dim NumCurLoc As Integer
Dim k As Integer
Dim UniqueRowsCR As Integer
Dim TempShortName As String
Dim FndUniques As Integer
Dim FoundRange As Range
Dim TempLongName As String
Dim tbl As ListObject
Dim sht As Worksheet
Dim test As Integer
'Unhide the Locations_Master and CrystalReport sheets so we can work on them, set tbl to be the Locations_Master_Table, and startup the ImportProgressForm
Sheets("Locations_Master").Visible = True
Sheets("CrystalReport").Visible = True
Set tbl = Sheets("Locations_Master").ListObjects("Locations_Master_Table")
Set sht = Sheets("CrystalReport")
ImportProgressForm.TaskLabel.Caption = "Abbreviating imported 'Campus Location' names and" & vbNewLine & "adding any new locations to the Database"
ImportProgressForm.Show (vbModeless)
Progress (0)
With sht
'Find the column number of the LOCATION in the CrystalReport sheet
LCol = .Rows(1).Find(what:="LOCATION", LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'Determine the number of unique locations imported
UniqueRowsCR = CountUnique(.Range(.Cells(2, LCol), .Cells(NumRows, LCol)))
End With
'Initialize the last location found with empty string
TempShortName = ""
'State that we have not found any of the unique locations yet
FndUniques = 0
'This is the row where we start looking at the Crystal Report information
k = 2
'Determine the number of campus locations already listed in the Locations_Master sheet
If tbl.DataBodyRange Is Nothing Then
'Preset the number of current locations in the Locations_Master_Table to 1
NumCurLoc = 1
'Add the newly found first location name to the Locations_Master_Table
TempLongName = sht.Cells(2, LCol).Value
With tbl
.ListRows.Add AlwaysInsert:=True
.DataBodyRange(NumCurLoc, 2).Value = TempLongName
'Call up a form for the user to enter a shorter name for the first location on the Crystal Report
LocationNameForm.LongLocationLabel.Caption = TempLongName
LocationNameForm.NewRowNumLabel.Caption = NumCurLoc
LocationNameForm.Show
'Find all occurences of this long Location name in the CrystalReport and replace them with the shortened name
TempShortName = .DataBodyRange(NumCurLoc, 1).Value
End With
With sht
.Range(.Cells(2, LCol), .Cells(NumRows, LCol)).Select
Selection.Replace what:=TempLongName, Replacement:=TempShortName, lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
End With
'Indicate that we have found our first of UniqueRowsCR unique campus.
FndUniques = 1
'This is the new row where we start looking at the Crystal Report information
k = 3
Else
NumCurLoc = tbl.DataBodyRange.Rows.Count
End If
Do
'Look at the kth row of the Locations column to see if the value is the last shortened name. If it is, move down a row. If not...
If sht.Cells(k, LCol).Value <> TempShortName Then
'Set the new LongName to this newly found value
TempLongName = sht.Cells(k, LCol).Value
'Look to see if this Location is already in the Locations_Master (long name) sheet
Set FoundRange = tbl.DataBodyRange.Columns(2).Find(what:=TempLongName, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'If this location is NOT in the Locations_Master sheet...
If FoundRange Is Nothing Then
'Indicate that we are adding a row to the Locations_Master list
NumCurLoc = NumCurLoc + 1
With tbl
'Put the long name into the Locations_Master sheet as well
.ListRows.Add AlwaysInsert:=True
.DataBodyRange(NumCurLoc, 2).Value = TempLongName
'Call up a form for the user to enter a shorter name for the first campus on the Crystal Report and save this information to the Locations_Master sheet
LocationNameForm.LocationLabel.Caption = TempLongName
LocationNameForm.NewRowNumLabel.Caption = NumCurLoc
LocationNameForm.Show
'Set the new TempShortName to be the new clean value the user just created
TempShortName = .DataBodyRange(NumCurLoc, 1).Value
End With
Else 'What if this location was ALREADY in the Locations_Master sheet?
'Refind this location and offset to find out the shortened name - I need to figure out how to shorten this
TempShortName = FoundRange.Offset(0, -1).Value
End If
'Select the remaining Locations in the column and replace matching long names with this new short name sht.Range(sht.Cells(k, LCol), sht.Cells(NumRows, LCol)).Select
sht.Range(sht.Cells(k, LCol), sht.Cells(NumRows, LCol)).Select
Selection.Replace what:=TempLongName, Replacement:=TempShortName, lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
'Tell the world that we have found yet another unique location
FndUniques = FndUniques + 1
End If
k = k + 1
Loop Until FndUniques = UniqueRowsCR
'Rehide the Locations_Master sheet and kill the ImportProgressForm
Sheets("Locations_Master").Visible = False
Sheets("CrystalReport").Visible = False
Unload ImportProgressForm
End Sub
Display More