Find a value from a column and quickly return the row number of its cell - vba

What I have
I have a file with part numbers and several suppliers for each part. There are 1500 parts with around 20 possible suppliers each. For the sake of simplicity let's say parts are listed in column A, with each supplier occupying a column after that. Values under the suppliers are entered manually but don't really matter.
In another sheet, I have a list of parts that is imported from an Access database. The parts list is imported, but not the supplier info. In both cases, each part appears only once.
What I want to do
I simply want to match the supplier info from the first sheet with the parts in the imported list. Right now, I have a function which goes through each part in the list with suppliers, copies the supplier information in an array, finds the part number in the imported part list (there is always a unique match) and copies the array next to it (with supplier info inside). It works. Unfortunately, the find function slows down considerably each time it is used. I know it is the culprit through various tests, and I can't understand why it slows down (starts at 200 loop iterations per second, slows down to 1 per second and Excel crashes) . I may have a leak of some sort? The file size remains 7mb throughout. Here it is:
Function LigneNum(numAHNS As String) As Integer
Dim oRange As Range, aCell As Range
Dim SearchString As String
Set oRange = f_TableMatrice.Range("A1:A1500")
SearchString = numAHNS
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'We have found the number by now:
LigneNum = aCell.Row
Exit Function
Else
MsgBox "Un numéro AHNS n'a pas été trouvé: " & SearchString
Debug.Print SearchString & " not found!"
LigneNum = 0
Exit Function
End If
End Function
The function simply returns the row number on which the value is found, or 0 if it doesn't find it which should never happen.
What I need help with
I'd like either to identify the cause of the slow down, or find a replacement for the Find method. I have used the Find before and it is the first time this happens to me. It was initially taken from Siddarth Rout's website: http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/ What is strange is that it doesn't start slow, it just becomes sluggish as it goes on.
I think using Match could work, or maybe dumping the range to search (the part numbers) into an array and trying to match these with the imported parts number list could work. I am unsure how to do it, but my question is more about which one would be faster (as long as it remains under 15 seconds I don't really care, though, but looping over 1500 items 1500 times right out of the sheet is out of the question). Would anyone suggest match over the array solution / spending more hours fixing my code?
EDIT
Here is the loop it is being called from. I don't think it is problematic:
For Each cellToMatch In rngToMatch
Debug.Print cellToMatch.Row
'The cellsToMatch's values are the numbers I want, rngToMatch is the column where they are.
For i = 2 To nbSup + 1
infoSup(i - 2) = f_TableMatrice.Cells(cellToMatch.Row, i)
Next
'infoSup contains the required supplier data now
'I call the find function here to find the row where the number appears in the imported sheet
'To copy the array nbSup on that line
LigneAHNS = LigneNum(cellToMatch.Value) 'This is the Find function
If LigneAHNS = 0 Then Exit Sub
'This loop just empties the array in the right line.
For i = LBound(infoSup) To UBound(infoSup)
f_symix.Cells(LigneAHNS, debutsuppliers + i) = infoSup(i)
Next
Next
If I replace LigneAHNS = LigneNum by LigneAHNS = 20, for example, the code executes extremely fast. The leak therefore comes from the find function itself.

Another way to do it without using the find function might be something like this. Firstly, put the part IDs and their line numbers into a scripting dictionary. These are really quick to lookup from. Like this:
Dim Dict As New Scripting.Dictionary
Dim ColA As Variant
Lastrow=range("A50000").end(xlUp).Row
ColA = Range("A1:A" & LastRow).Value
For i = 1 To LastRow
Dict.Add ColA(i, 1), i
Next i
To further optimise, you could declare the Dict as a public variable, populate it once, and refer to it many times in your lookups. I expect this would be faster than running a cells.find over a range every time you do a lookup.
For syntax of looking up items in the dictionary, refer to Looping through a Scripting.Dictionary using index/item number

You could achieve this with only Excel cell formulas and no VB if you are willing to devote a separate column to each supplier on your main parts sheet. You could then use conditional formatting to make it more visually appealing. I've tried it with 1500 rows and it's very quick. Increasing it to 5000 rows becomes noticeably slower, but you say you have only 1500 rows for now, so it should be suitable.
On Sheet 1, define a part number column and a separate column for each supplier.
Create a separate sheet for each supplier with all part numbers available from that supplier listed in column A. Make sure the rows on the supplier sheets are ordered by part number.
Name each of the supplier sheets the same as the associated column heading shown on Sheet 1.
Assign the following formula in each cell beneath each supplier column heading on Sheet 1:
=NOT(ISNA(VLOOKUP($A2,INDIRECT("'"&B$1&"'!A:A"),1,FALSE)))
The following screen cap shows this implemented along with conditional formatting to highlight which suppliers have which parts:
If you wanted to show quantities available from suppliers, then you could always have a second column (B) on the supplier sheets containing last known quantities for each part and use VLOOKUP to retrieve column B instead of A.

Related

Using a Linest Function within a Nested Loop

I am working with VBA and I'm very much a novice. I basically have 3 columns of data which act as the independent variable (MSCI Value, Growth and Small Cap) and then a blank column followed by numerous columns containing fund data (dependent variables). Most of these have the same number of rows but a few do not.
I am looking to use the Linest Function in excel to produce the coefficient (beta) of each fund with each independant variable separately (MSCI growth, Value, Small cap). I am unsure what is the best way to set out my data and vba. And thoughts/ ideas would be much appreciated.
Currently my thoughts are a nested loop. Whereby I use the Linest function to regress the first independent variable (MSCI Growth, column 2) against the first dependent variable (column 6) and this column number in the range is incremented each time until the column is blank (there are no more funds), and when this happens it loops back to the first fund but changes to the next independent variable (MSCI Value, column 3). This process is repeated until the last independent variable (MSCI Growth, column 4) is regressed against the last fund.
My problem so far has been 1) creating a Linest Function using named ranges
2) creating a table where the results of the loop are placed.
Set StartCell = Range("B9")
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set gRange = Range(StartCell, Cells(LastRow, 2)) 'MSCI growth range
Range("M21").value = Evaluate("Linest(gRange,G9:G112)") 'column G contains the first fund.
This code doesn't run, I think it has something to do with the array formula, I only need the coefficient so do not need to run the whole array.
I tried using cell references but when I ran the code I got #VALUE
Range("M22").value = Evaluate("Linest(Range((cells(9,2):cells(112,2)),Range(cells(9,7):cells(112,7)))")
Maybe I am going about this the wrong way, I want to create a global macro I can use on other sheets but I am unsure how to approach the task.
you need to remove the vba part from the quotes and concatenate.
ActiveSheet.Range("M21").value = ActiveSheet.Evaluate("Linest(" & gRange.Address(0,0) & ",G9:G112)")(1)
The Second one:
With ActiveSheet
.Range("M22").value = .Evaluate("Linest(" & .Range(.cells(9,2),.cells(112,2)).Address(0,0) & "," & .Range(.cells(9,7),.cells(112,7)).Address(0,0) & ")")(1)
End With
This will also error if the two ranges are not the same size. So make sure they are.

Find and placing elements in a long string/column of text

The following is the result of downloading information from an accounting system. Basically, I was tasked with sorting through expenses from this year from an online system; once the information was downloaded from the online system, it was not formatted as a spreadsheet (so I couldn't easily use a simple lookup). The information was downloaded as a spreadsheet, however it didn't contain check numbers or names; excel formatted those away for some reason. The only thing that was left is the long stringy document, where each item in the PDF downloaded (which contained check numbers and names) was placed in column 1 (see picture 1), whereas it should have been placed in something formatted like picture 2. Obviously though PDF's do not maintain formatting.
So baring some way that I can transfer the PDF to a workbook and run an analysis (IE through copy paste or save as) I needed to get information from this long stringy thing (it's at 9000 rows at the moment, added in an excerpt).
First, this code sets the worksheet pers as a worksheet, gets the length of data in pers (example in picture 2), and length of data in expensesheet (example in picture 1)
Then it scans pers for items (prior to writing this code items were added manually - such as in the case of picture 2, 'supply 1' and corresponding information that can help denote supply 1, ie invoice #, description, date cut, and so on).
For each of those items, it then scans the "expense sheet". It tries to match the invoice number (which is the closest thing to a unique ID in this case) to the value in cell i, 1; if it exists, it then scans 'upwards' until it finds a long enough string so that it can be the 5 unit string; the one that contains a date, a check number, an amount, and a name, as well as a batch number and a memo.
Once it finds that string, it then splits it into an array, and then seeks to place it in the corresponding cells to the right of that row in worksheet pers.
Issues:
1) I keep receiving an error 400. Normally when I receive an error VBA shows what line. What is this? How can I set up an error catching block so that the editor will provide me more details on the error (ie place it occurred, reason for occurrence, etc)
2) I'm assuming that the long row (in this case its 12th from the top) can only be identified through its length. Is there a better way to identify the long row? Perhaps if it contains multiple dashes?
3) Does anyone know of a way to easily transfer a PDF of an accounting printout so that it retains its formatting when saved or copied to a spreadsheet?
4) Is there a way that this spreadsheet could be easily formatted through excel so that it can more adequately fit into the proper mold (more like picture 2)?
Option Explicit
Sub findDetailMemo()
Dim pers As Worksheet
Set pers = ThisWorkbook.Sheets("PERS")
Dim persLength As Long
persLength = pers.Range("a1").End(xlDown).Row
Dim expenseLength As Long
expenseLength = Range("a1").End(xlDown).Row
Dim currentDetail() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempInt As Long
'first scan all of the items in the pers unit
For k = 2 To 10
'next scan all of the expenses
For i = 2 To expenseLength
'if the invoice # is found
If InStr(Cells(i, 1), pers.Range("a1").Offset(k, 3)) <> 0 Then
'scan upwards; make sure you don't scan beyond the range of the spreadsheet
For j = i To 1 Step -1
'if the scan upwards finds a string that is 80 characters or more
If Len(Cells(i - j, 1)) >= 80 Then
'split it at the -
currentDetail = Split(Cells(i - j, 1), "-", -1, vbTextCompare)
'add it to the pers sheet
pers.Range("a1").Offset(k, 11) = currentDetail(0)
pers.Range("a1").Offset(k, 12) = currentDetail(1)
pers.Range("a1").Offset(k, 13) = currentDetail(2)
pers.Range("a1").Offset(k, 14) = currentDetail(3)
Exit For
End If
Next j
Exit For
Else
End If
Next i
Next k
End Sub
EDIT: After a discussion through the chat lobby, bdpolinsky and I found what was throwing the original error 400 (which was actually error 1004).
The first issue we fixed was the InStr() and Split() functions were referencing Cell objects instead of the string within them. This was fixed by simply adding Cells().Text where strings were required.
On the line If Len(Cells(i - j, 1).Text) >= 80, we discovered that Cells() wasn't referencing the correct worksheet. The fix for this was to define Cells() as pers.Cells(), which is the worksheet the information was imported to. Happy to report that the problem bdpolinsky was having has been solved (as far as the errors go).
The following is from the original answer:
1) At the start of your code (first executable line) you can press F8 to step through the code 1 line at a time until the error is flagged.
You can also use error handlers to catch an error and have excel do something different than default. Error Handling
Sub SomeCode()
Dim i As Integer
On Error GoTo ErrHandler
i = 1/0
ErrHandler:
MsgBox "Error Description: " & Err.Description
End Sub
You can also click next to a line of code to add a Break. Breaks look like red circles, and color that line of code red. Your code will stop when it reaches this line.
2)If Len(cellThatYoureChecking) > 20 Then Code
Or
If InStr(cellThatYoureChecking, "symbolYouWantToFind") <> 0 Then Code
Or visit this post about defining how many times a character is in a string with a function. You could then make your If statement based on the number of times it occurs.
3) This part is poor form for StackOverflow, but what you're asking is a little involved so see if this tutorial is of use to you. Import table from PDF to Excel.
4) The short answer to this is yes. There are a lot of ways to reorganize data in Excel. This question is a little too broad though, and it'd be more efficient to get questions 1-3 answered first before getting too ahead of ourselves.

Selecting all data from a default table size VBA Excel

I have a spread sheet with a default table size and layout that is populated by information from another spread sheet. This table will always have the same number of columns, but the number of entries in the rows can vary. I want to select all the data from the table, and paste it into another sheet, without copying any empty rows.
My initial attempt involved the following code:
Set rightcell = Range("B9").End(x1Right)
Set bottomcell = Range(rightcell).End(x1Down)
To define what the bottom right corner should be, so I can reference the entire table like so:
Range("B9", bottomcell).Select
Or copy or whatever. When I run this, it gives me a "user-defined or object-defined error" and I don't know why. I have the code entered as part of a larger sub, and I have defined my variables as both ranges and variants to try and get this to work. I have spent quite a bit of time scouring the internet for a solution, but so far the information I've found has not explicitly related to my problem, and none of the similar solutions work.
Does anyone know what the appropriate coding for this is, or if I am making some minor error that is throwing everything else off? I remember encountering the same issue during a project in college, but for the life of me, I can't recall the solution. It's quite frustrating.
Also, if I am too vague or you need more clarification on the task, don't hesitate to ask. Thanks in advance for the help!
EDIT: An important note that I left out is that the the table I want to extract data from is in the middle of a page with multiple other tables that I am not trying to interact with.
If the table will always be in the same location on the sheet, you can do something like this to copy the entire table:
'Modify this to any cell in your table (like the top left hand cell):
Range("B9").CurrentRegion.Copy Sheets("TheSheetYouWantToPasteTo").Range("A1")
Even if the table's location on the sheet changes, you can still use the above code to copy the table as long as you know one of the cells in the table.
If you want to keep the same method as you're trying, try this instead:
Dim rightcell As Long
Dim bottomcell As Long
'Finds the furthest column to the right:
rightcell = Cells(5, Columns.Count).End(xlToLeft).Column
'Finds the bottom most row in the table (will stop at the first non-blank cell it finds.)
bottomcell = Range("B:B").Find("*", Range("B9"), searchdirection:=xlPrevious).Row
'Reference the variables like this:
Range(Cells(9, 2), Cells(bottomcell, rightcell)).copy _
Sheets("TheSheetYouWantToPasteTo").Range("A1")
this is what I use
Public Function last_row() As Long
Dim i As Integer
Dim l_row As Long
'my sheet has 35 columns change this number to fit your
For i = 1 To 35
If Sheet1.Cells(Rows.Count, i).End(xlUp).Row > l_row Then
l_row = Sheet1.Cells(Rows.Count, i).End(xlUp).Row
End If
Next i
last_row = l_row
End Function
Then Use
Dim l_row As Long
l_row = last_row
'Again since you know the last column change 35 here to your value
'or use the String i.e. "AI"
Range("B9", Cells(l_row,35)).Select
This will look at every column to determine the the last row that contains data

Why is my conditional format offset when added by VBA?

I was trying to add conditional formats like this:
If expression =($G5<>"") then make set interior green, use this for $A$5:$H$25.
Tried this, worked fine, as expected, then tried to adapt this as VBA-Code with following code, which is working, but not as expected:
With ActiveSheet.UsedRange.Offset(1)
.FormatConditions.Delete
'set used row range to green interior color, if "Erledigt Datum" is not empty
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:="=($" & cstrDefaultProgressColumn & _
.row & "<>"""")")
.Interior.ColorIndex = 4
End With
End With
The Problem is, .row is providing the right row while in debug, however my added conditional-formula seems to be one or more rows off - depending on my solution for setting the row. So I am ending up with a conditional formatting, which has an offset to the row, which should have been formatted.
In the dialog it is then =($G6<>"") or G3 or G100310 or something like this. But not my desired G5.
Setting the row has to be dynamicall, because this is used to setup conditional formats on different worksheets, which can have their data starting at different rows.
I was suspecting my With arrangement, but it did not fix this problem.
edit: To be more specific, this is NOT a UsedRange problem, having the same trouble with this:
Dim rngData As Range
Set rngData = ActiveSheet.Range("A:H") 'ActiveSheet.UsedRange.Offset(1)
rngData.FormatConditions.Delete
With rngData.FormatConditions.Add(Type:=xlExpression, _
Formula1:="=($" & cstrDefaultProgressColumn & _
1 & "<>"""")")
.Interior.ColorIndex = 4
End With
My Data looks like this:
1 -> empty cells
2 -> empty cells
3 -> empty cells
4 -> TitleCols -> A;B;C;...;H
5 -> Data to TitleCols
. .
. .
. .
25
When I execute this edited code on Excel 2007 and lookup the formula in the conditional dialog it is =($G1048571<>"") - it should be =($G1<>""), then everything works fine.
Whats even more strange - this is an edited version of a fine working code, which used to add conditional formats for each row. But then I realized, that it's possible to write an expression, which formats a whole row or parts of it - thought this would be adapted in a minute, and now this ^^
edit: Additional task informations
I use conditional formatting here, because this functions shall setup a table to react on user input. So, if properly setup and a user edits some cell in my conditionalized column of this tabel, the corresponding row will turn green for the used range of rows.
Now, because there might be rows before the main header-row and there might be a various number of data-columns, and also the targeted column may change, I do of course use some specific informations.
To keep them minimal, I do use NamedRanges to determine the correct offset and to determine the correct DefaultProgessColumn.
GetTitleRow is used to determine the header-row by NamedRange or header-contents.
With ActiveSheet.UsedRange.Offset(GetTitleRow(ActiveSheet.UsedRange) - _
ActiveSheet.UsedRange.Rows(1).row + 1)
Corrected my Formula1, because I found the construct before not well formed.
Formula1:="=(" & Cells(.row, _
Range(strMatchCol1).Column).Address(RowAbsolute:=False) & _
"<>"""")"
strMatchCol1 - is the name of a range.
Got it, lol. Set the ActiveCell before doing the grunt work...
ActiveSheet.Range("A1").Activate
Excel is pulling its automagic range adjusting which is throwing off the formula when the FromatCondition is added.
The reason that Conditional Formatting and Data Validation exhibit this strange behavior is because the formulas they use are outside the normal calculation chain. They have to be so that you can refer to the active cell in the formula. If you're in G1, you can't type =G1="" because you'll create a circular reference. But in CF or DV, you can type that formula. Those formulas are disassociated with the current cell unlike real formulas.
When you enter a CF formula, it's always relative to the active cell. If, in CF, you make a formula
=ISBLANK($G2)
and you're in A5, Excel converts it to
=ISBLANK(R[-3]C7)
and when that gets put into the CF, it ends up being relative to the cell it's applied to. So in row 2, the formula comes out to
=ISBLANK($G655536)
(for Excel 2003). It offsets -3 rows and that wraps to the bottom of the spreadsheet.
You can use Application.ConvertFormula to make the formula relative to some other cell. If I'm in row 5 and the start of my range is in row 2, I make the formula relative to row 8. That way the R[-3] will put the formula in A5 as $G5 (three rows up from A8).
Sub test()
Dim cstrDefaultProgressColumn As String
Dim sFormula As String
cstrDefaultProgressColumn = "$G"
With ActiveSheet.UsedRange.Offset(1)
.FormatConditions.Delete
'set used row range to green interior color, if "Erledigt Datum" is not empty
'Build formula
sFormula = "=ISBLANK(" & cstrDefaultProgressColumn & .Row & ")"
'convert to r1c1
sFormula = Application.ConvertFormula(sFormula, xlA1, xlR1C1)
'convert to a1 and make relative
sFormula = Application.ConvertFormula(sFormula, xlR1C1, xlA1, , ActiveCell.Offset(ActiveCell.Row - .Cells(1).Row))
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:=sFormula)
.Interior.ColorIndex = 4
End With
End With
End Sub
I only offset .Cells(1) row-wise because the column is absolute in this example. If both row and column are relative in your CF formula, you need more offsetting. Also, this only works if the active cell is below the first cell in your range. To make it more general purpose, you would have to determine where the activecell is relative to the range and offset appropriately. If the offset put you above row 1, you would need to code it so that it referred to a cell nearer the bottom of the total number of rows for your version of Excel.
If you thought selecting was a bit of a kludge, I'm sure you'll agree that this is worse. Even though I abhor unnecessary Selecting and Activating, Conditional Formatting and Data Validation are two places where it's a necessary evil.
A brief example:
Sub Format_Range()
Dim oRange As Range
Dim iRange_Rows As Integer
Dim iCnt As Integer
'First, create a named range manually in Excel (eg. "FORMAT_RANGE")
'In your case that would be range "$A$5:$H$25".
'You only need to do this once,
'through VBA you can afterwards dynamically adapt size + location at any time.
'If you don't feel comfortable with that, you can create headers
'and look for the headers dynamically in the sheet to retrieve
'their position dynamically too.
'Setting this range makes it independent
'from which sheet in the workbook is active
'No unnecessary .Activate is needed and certainly no hard coded "A1" cell.
'(which makes it more potentially subject to bugs later on)
Set oRange = ThisWorkbook.Names("FORMAT_RANGE").RefersToRange
iRange_Rows = oRange.Rows.Count
For iCnt = 1 To iRange_Rows
If oRange(iCnt, 1) <> oRange(iCnt, 2) Then
oRange(iCnt, 2).Interior.ColorIndex = 4
End If
Next iCnt
End Sub
Regarding my comments given on the other reply:
If you have to do this for many rows, it is definitely faster to load the the entire range into memory (an array) and check the conditions within the array, after which you do the writing on those cells that need to be written (formatted).
I could agree that this technique is not "necessary" in this case - however it is good practise because it is flexible for many (any type of) customizations afterwards and easier to debug (using the immediate / locals / watches window).
I'm not a fan of Offset although I don't state it doesn't work as it should and in some limited scenarios I could say that the chance for problems "could" be small: I experienced that some business users tend to use it constantly (here offset +3, there offset -3, then again -2, etc...); although it is easy to write, I can tell you it is hell to revise. It is also very often subject to bugs when changes are made by end users.
I am very much "for" the use of headers (although I'm also a fan of reducing database capabilities for Excel, because for many it results in avoiding Access), because it will allow you very much flexibility. Even when I used columns 1 and 2; better is it to retrieve the column nr dynamically based on the location of the named range of the header. If then another column is inserted, no bugs will appear.
Last but not least, it may sound exaggerated, but the last time, I used a class module with properties and functions to perform all retrievals of potential data within each sheet dynamically, perform checks on all bugs I could think of and some additional functions to execute specific tasks.
So if you need many types of data from a specific sheet, you can instantiate that class and have all the data at your disposal, accessible through defined functions. I haven't noticed anyone doing it so far, but it gives you few trouble despite a little bit more work (you can use the same principles again over and over).
Now I don't think that this is what you need; but there may come a day that you need to make large tools for end users who don't know how it works but will complain a lot about things because of something they might have done themselves (even when it's not your "fault"); it's good to keep this in mind.

VBA Assistance needed. trying to select a range of cells, cut, move and paste

I have a spread sheet that is updated weekly. What i need to do is cut come of the cells and paste to a new location. I have never used macros or VBA before but I am getting frustrated with the amount of time I spend doing this. I know that I can use a macro but don't know how to write it.
I am trying to move the name of the hotel and resort to the left of the passengers title
R81C00 CHALET LE VALENTIN SAUZE D'OULX
MR HAYHOE 8
MR GLOVER 2
This repeats throughout the spread sheet. The number of lines between the names is dependent on information further right in the sheet.
546L
__________1 RESORT INFORMATION
__________5 SKI/S.BOARD CARRIAGE
__________8 AD L/P BRN BF 31/12/99
what I would like to do here is move these lines onto the same line as the flight number (this is the same line as passenger details) and then delete the lines with no data. this way all the details would be on the same line and then i would just need to fill down for the hotel names.
thanks in advance for any help please let me know if i haven't explained it clearly.
Trying to keep this general enough to be of use to other people, the basic process to follow would be:
find the next hotel/resort combination
find each passenger for that hotel/resort
add in the details for the other attributes
move on to the next passenger
move on to the next hotel/resort
If we start with finding the hotel/resort combination and we assume that this is on Sheet1 in column A in a single cell and that nothing else is in column A then we would need this macro:
Option Explicit
Sub main()
Dim lngCurrRow As Long
Dim lngMaxRow As Long
With ThisWorkbook.Worksheets("Sheet1")
lngMaxRow = .UsedRange.Rows.Count
For lngCurrRow = 1 To lngMaxRow
If (.Cells(lngCurrRow, 1).Value <> "") Then
MsgBox .Cells(lngCurrRow, 1).Value
End If
Next lngCurrRow
End With
End Sub
This should pop up a message box with the name of each hotel/resort in turn.
All the code does is work out how many used rows there are on the worksheet (and stores that in lngMaxRow) and then works through every used row (using lngCurrRow to keep track of which row we are on) checking the value of the cell in column A on that row (the .Cells(lngCurrRow, 1).Value part). If there is something in that cell (the (<> "" part) then it displays the value of that cell.
The more difficult case is when there is other data in column A (e.g. if the passenger names were also in column A). In that scenario, we need a way to easily recognise what is a hotel/resort combination and what is a passenger name but I don't have enough info about your current structure to determine how to do that