VBA Excel Populate ListBox with multiple columns - vba

This may be a cheap question for some but I'm totally confused on how to populate my listbox.
Using this line I can populate the listbox as shown below:
ListBox1.List = Sheets("Sheet1").Cells(1, 1).CurrentRegion.Value
or
Dim rngName As Range
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("Sheet1")
For i = 1 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row Step 1
If ws.Cells(i, 1).Value <> vbNullString Then Me.ListBox1.AddItem
ws.Cells(i, 1).Value
Next i
Below is the data I'm planning to use to populate the list box and is progressive. Only the column has the fix count.
Someone please enlighten me on how to populate a list box adapative to multiple columns and rows using FOR LOOP as shown in my code above. Any help appreciated. Thanks.

Methods
It's always better to loop through an array than a range - it's much faster.
It's even faster to create a variant data field array with a one liner instead of redimensioning a predeclared array and fill it in an extra loop as proposed by Siddharth Rout (though a good method :-) Note: The code below is based on his Approach referenced in the above comment just to demonstrate the difference.
Fill ListBox1.List with the array (same method, but reverse direction).
Code
Private Sub CommandButton1_Click()
' Purpose: fill listbox with range values after clicking on CommandButton1
' (code could be applied to UserForm_Initialize(), too)
' Note: based on #Siddharth-Rout 's proposal at https://stackoverflow.com/questions/10763310/how-to-populate-data-from-a-range-multiple-rows-and-columns-to-listbox-with-vb
' but creating a variant data field array directly from range in a one liner
' (instead of filling a redimensioned array with range values in a loop)
Dim ws As Worksheet
Dim rng As Range
Dim MyArray ' variant, receives one based 2-dim data field array
'~~> Change your sheetname here
Set ws = Sheets("Sheet1")
'~~> Set you relevant range here
Set rng = ws.Range("A1:C" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
With Me.ListBox1
.Clear
.ColumnHeads = False
.ColumnCount = rng.Columns.Count
'~~> create a one based 2-dim datafield array
MyArray = rng
'~~> fill listbox with array values
.List = MyArray
'~~> Set the widths of the column here. Ex: For 5 Columns
'~~> Change as Applicable
.ColumnWidths = "50;50;50"
.TopIndex = 0
End With
End Sub
Additional hints
Another advantage of the array method - it overcomes the built-in limitation of only 10 columns when using the .AddItem method.
Furthermore, keep in mind that listbox indexing is zero based, so for example you get the e-mail address (column 3, index 2) of your first item row (index 0) via ListBox1.List(0, 2), whereas the data field array becomes automatically a one based 2-dim array.
You aren't restricted to use the .List method to get Information out of the listbox, you can reverse the row - column order by using ListBox1.Column" or even create a new array out of it, which remains a 2-dim object, even if there is only ONE item (note: theApplication.Transpose` method would redim a 2 dimensional array with only one row to a 1-dim array).
A last point: you can easily dump back again the whole listbox to an Excel sheet via rng = ListBox1.List, but take care to define the correct range.

How about this:
Sub foo()
Dim rngName As Range
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("Sheet1")
ListBox1.Clear
ListBox1.columnCount = 3
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow
If ws.Cells(i, 1).Value <> vbNullString Then ListBox1.AddItem ws.Cells(i, 1).Value
If ws.Cells(i, 2).Value <> vbNullString Then ListBox1.List(i - 1, 1) = ws.Cells(i, 2).Value
If ws.Cells(i, 3).Value <> vbNullString Then ListBox1.List(i - 1, 2) = ws.Cells(i, 3).Value
Next i
End Sub

Related

Unable to create a loop to compare the content of two sheets

I've written a script which is supposed to compare the content of column A between two sheets in a workbook to find out if there are partial matches. To be clearer: If any of the content of any cell in coulmn A in sheet 1 matches any of the content of any cell in coulmn A in sheet 2 then that will be a match and the script will print that in immediate window.
This is my attempt so far:
Sub GetPartialMatch()
Dim paramlist As Range
Set paramlist = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each cel In Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If InStr(1, cel(1, 1), paramlist, 1) > 0 Then 'I used "paramlist" here as a placeholder as I can't use it
Debug.Print cel(1, 1)
End If
Next cel
End Sub
The thing is I can't make use of this paramlist defined within my script. I just used it there as a placeholder.
a very fast approach is given by the use of arrays and Application.Match() function:
Sub GetPartialMatch()
Dim paramlist1 As Variant, paramlist2 As Variant
Dim cel As Range
Dim i As Long
paramlist1 = Sheets(1).Range("A2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Value ' collect all sheets(1) column A values in an array
paramlist2 = Sheets(2).Range("A2", Sheets(2).Cells(Rows.Count, 1).End(xlUp)).Value ' collect all sheets(2) column A values in an array
For i = 1 To UBound(paramlist1) ' loop through paramlist1 array row index
If Not IsError(Application.Match(paramlist1(i, 1), paramlist2, 1)) Then Debug.Print paramlist1(i, 1) ' if partial match between current paramlist1 value and any paramlist2 value, then print it
Next
End Sub
if you want an exact match just use 0 as the last parameter in Match() function, i.e.:
If Not IsError(Application.Match(paramlist1(i, 1), paramlist2, 0)) Then Debug.Print paramlist1(i, 1) ' if exact match between current paramlist1 value and any paramlist2 value, then print it
BTW, if you need an exact match you could also use Autofilter() method of Range object with xlFilterValues as its Operator parameter:
Sub GetPartialMatch2()
Dim paramlist As Variant
Dim cel As Range
paramlist = Application.Transpose(Sheets(1).Range("A2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Value) ' collect all sheets(1) column A values in an array
With Sheets(2).Range("A1", Sheets(2).Cells(Rows.Count, 1).End(xlUp)) ' reference sheets(2) column A cells from row 1 (header) down to last not empty one
.AutoFilter field:=1, Criteria1:=paramlist, Operator:=xlFilterValues ' filter referenced range with 'paramlist'
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any filtered cell other then header
For Each cel In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' loop through all sheets(2) filtered cells but the header
Debug.Print cel.Value2
Next
End If
.Parent.AutoFilterMode = False 'remove filter
End With
End Sub
You want a double loop.
Sub GetPartialMatch()
Dim paramlist As Range
Dim cel as Range, cel2 as Range ; declare all variables!
Set paramlist = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each cel In Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each cel2 in paramlist 'Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If InStr(1, cel(1, 1), cel2, 1) > 0 Then
Debug.Print cel(1, 1)
End If
Next cel2
Next cel
End Sub
Always use Option Explicit. Always.
This may be easier using a helper column and a formula, where the row in the helper column indicates TRUE if a MATCH is found. No VBA then. And it will be inherently faster.
Have you tried adding in:
Application.Screenupdating = false
Application.Calculation = xlCalculationManual
...Code...
Application.Screenupdating = true
Application.Calculation = xlCalculationAutomatic
These turn off the screen updating and automatic calculation of formulas within your instance of excel which can help speed up code a lot, you just have to remember to turn them back on at the end or you might give yourself a bit of a headache. It should be noted, though, that if you turn off screenupdating you won't be able to see the results roll in. You'll have to scroll backwards at the end
Another thing to consider would be store the data in an array before hand and doing the operations to the array and simply pasting it back in to the sheet. Accessing the sheet excessively slows down code drastically. Working with the accepted answer provided by #AJD, I made a few changes that will hopefully speed it up.
Sub macro()
Dim paramlist() As Variant
Dim DataTable() As Variant
Dim cell1 As Variant
Dim cell2 As Variant
paramlist() = Sheets(1).Range("A2:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Value
DataTable() = Sheets(2).Range("A2:A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row).Value
For Each cell1 In paramlist
For Each cell2 In DataTable
If InStr(1, cell2, cell1, 1) > 0 Then
Debug.Print cell1
exit for
End If
Next cell2
Next cell1
End Sub
I would have suggested this under the accepted answer as a suggestion, but unfortunately, I don't have enough rep to comment yet.
Edit: switching the order of the for loops allows you to insert a more efficient exit for and can allow you to skip large portions of data within the search array
Not sure if this is any faster (it uses pretty much the same algorithm, a loop inside of a loop), but I would argue it's a bit clearer:
Sub SearchForPartialMatches()
Dim needle1 As Range, needle2 As Range
Set needle1 = Excel.Worksheets(1).Range("$B$2")
Do While needle1.Value <> ""
Set needle2 = Excel.Worksheets(2).Range("$B$2")
Do While needle2.Value <> ""
If InStr(1, needle1.Value, needle2.Value) > 0 Then
Debug.Print needle1.Value, needle2.Value
End If
Set needle2 = needle2.Offset(rowoffset:=1)
Loop
Set needle1 = needle1.Offset(rowoffset:=1)
Loop
End Sub
The main difference is it's not looping over the entire column, but instead starts at the top, and uses the offset method until there are no more rows (with data).
Of course, you'll need to change the starting cell for needle1 and needle2.
I ran this with the EFF large word list copied into both sheets, and it ran in about 4 minutes (which was less time than with #AJD, but that might've been a fluke). YMMV.
Just one more option. Not much different from any suggestions above ... The concept is to speed up processing by minimizing VBA - Excel interactions by loading the values to arrays and processing arrays like this:
Dim cel as String, cel2 as String
Dim arr1() as String, arr2 As String
arr1 = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
arr2 = Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each cel In arr1
For Each cel2 in arr2
If InStr(1, cel, cel2, 1) > 0 Then
Debug.Print cel
End If
Next cel2
Next cel
I'd like to know if it helps at all :)

VBA for hiding rows based on value

I have written a VBA code to select any row where a special value appears in a chosen column.
`Sub test()
vonZeile = 4 ' first row
bisZeile = Cells(vonZeile, 7).End(xlDown).Row
Spalte = 7 ' column G
Markierung = False
For Zeile = bisZeile To vonZeile Step -1
If (Cells(Zeile, Spalte).Value = "Werkstatt") Then
If Markierung Then
Union(Selection, Rows(Zeile)).Select
Else
Rows(Zeile).Select
Markierung = True
End If
End If
Next Zeile
If Zeilen > "" Then Selection.Delete Shift:=xlUp
End Sub`
This might not be the prettiest but it works pretty well and very fast.
Now I would like to change this code so that the rows with the specific value are not only selected but cut out or hidden.
I couldn't figure out how to change this code to get this.
I have a different code that does delete all these rows but it lats an eternity. But it should be much faster when all the rows with the specific value would be deleted at once.
Shouldn't there be a way to just change the .Select part in the code to maybe Hidden or Delete?
This is just a guessing as I am not very familiar with VBA coding.
Very happy to get some advice on this matter.
Thanks
Here's the fastest way I've found to do this: create an array the size of your original data, loop through the rows adding the keepers to the array, then clear all of the data from the worksheet(far less time consuming than deleting) and then lastly write the array of stored data to the sheet.
Option Explicit
Sub test()
Dim ws As Worksheet
Dim firstRow As Integer, lastRow As Integer
Dim lastCol As Integer, criteriaCol As Integer
Dim criteriaValue As Variant
Dim arr As Variant
Dim iRow As Integer, iCol As Integer, iCounter As Integer
'Set this to the worksheet you want to perform this procedure on
Set ws = ActiveSheet
'Set your first row, last row, criteria column, and last column
firstRow = 4
lastRow = Cells(firstRow, 7).End(xlDown).Row
lastCol = 7
criteriaCol = 7
criteriaValue = "Werkstatt"
'Resize the array to fit the length of your sheet
ReDim arr(1 To (lastRow - firstRow), 1 To lastCol)
'iCounter is used to track the position of the first dimension in arr
iCounter = 1
'For each row, if the value you are looking for matches then loop through each column and write it to the array
For iRow = firstRow To lastRow
If ws.Cells(iRow, criteriaCol).Value = criteriaValue Then
For iCol = 1 To lastCol
arr(iCounter, iCol) = ws.Cells(iRow, iCol)
Next
iCounter = iCounter + 1
End If
Next iRow
'Clear the specific rows on the sheet
ws.Rows(firstRow & ":" & lastRow).Cells.Clear
'Resize the range to fit the array and write it the worksheet
ws.Cells(firstRow, 1).Resize(firstRow + iCounter - 1, lastCol) = arr
End Sub
I now found the answer to my problem. It is just a change of one single line. I deleted the last line in my code If Zeilen > "" Then Selection.Delete Shift:=xlUp and replaced it by the following line Selection.EntireRow.Delete. This solves the problem and it also works fast which was very important to me. Thanks everyone for the help!

Assigning values to array vba

I don't have experience using arrays in VBA and I got lost. What I try to do is the following:
In the column A I have ~15 strings (number is not fixed sometimes it is more sometimes less)
I remove duplicates and then for each name in the column A I would like to create separate sheet in the file.
I created an array to which I tried to assign each name from A with this loop:
Sub assigningvalues()
Dim i As Integer
Dim myArray(20) As Variant
Dim finalrow As Long
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
finalrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
'For i = 2 To finalrow -> I get overflow error when I use this range
For i = 2 To Cells(20, 1)
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
Cells(2, 4).Value = myArray(4)
Cells(3, 4).Value = myArray(2)
End Sub
Nevertheless values from the cells to do not assign to the array
Moreover when I try to use finalrow as range for the loop I get overflow error (It is not a big problem as there are workarounds, although it would be nice to know what I've done wrong)
Try the code below:
Option Explicit
Sub assigningvalues()
Dim i As Long
Dim myArray(20) As Variant
Dim FinalRow As Long
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Sheets("Sheet1") ' modify "Sheet1" to your sheet's name
With Sht
.Range("A1", .Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row in column "A"
For i = 2 To FinalRow
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
.Cells(2, 4).Value = myArray(4)
.Cells(3, 4).Value = myArray(2)
End With
End Sub
Note: you can read the contents of the Range to a 1-D Array without a For loop, using Application.Transpose, you need to change the line you define it to:
Dim myArray As Variant
and populate the entire array using:
myArray = Application.Transpose(.Range("A2:A" & FinalRow))
Try the code below:
Sub assigningvalues()
Dim myArray As Variant
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
myArray = ActiveSheet.Range("A1", Range("A1").End(xlDown))
For Each element In myArray
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = element
Next element
End Sub
NOTES: The problem with your above code was, that
ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
returned the absolut number of rows in the sheet, not the used ones. Since your array has length 20 and the sheet about 1 Mio. rows, you have an overflow. you can check this by using
Debug.Print ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
In the above code, after you remove dublicates, you again go down from A1 to the end and save the range to an array. The array myArray now contains all the cell values in your reduced range.
Now you loop over the elements with
For Each element in myArray
and create a new sheet with Workbook.Sheets.Add and assign the name my setting Sheets(index).name = element
The above code should work for you. Few remarks:
Instead of using "ActiveSheet", ThisWorkbook, etc. You should always start a Sub with this:
Dim wb As Workbook
Set wb = ThisWorkbook 'for the workbook containing the code
Set wb = Workbooks(workbookName) 'to reference an other Workbook
'And for all the sheets you are using
Dim ws As Worksheet
Set ws = wb.Sheets(sheetName) 'this way you avoid problems with multiple
workbooks that are open and active or
unactive sheets.

creating a form in excel using VBA

I am trying to creat a form in excel using VBA, but I am stuck at the Code. I need to find out the code to enter a data to my worksheet using VBA form . here is the code I am using, but doesn't work..
Private Sub cmdAdd_Click()
Dim LastRow As Range
Dim DPDIAdhocRequestTable As ListObject
With LastRow
Cells(1, 2) = RequesterName.Value
Cells(1, 3) = RequesterPhoneNumber.Value
Cells(1, 4) = RequesterBureau.Value
Cells(1, 5) = DateRequestMade.Value
Cells(1, 6) = DateRequestDue.Value
Cells(1, 7) = PurposeofRequest.Value
Cells(1, 8) = ExpectedDataSaurce.Value
Cells(1, 9) = Timeperiodofdatarequested.Value
Cells(1, 10) = ReoccuringRequest.Value
Cells(1, 11) = RequestNumber.Value
Cells(1, 12) = AnalystAssigned.Value
Cells(1, 13) = AnalystEstimatedDueDate.Value
Cells(1, 14) = AnalystCompletedDate.Value
Cells(1, 15) = SupervisiorName.Value
End With
End Sub
can you help me to figure out the correct code for enter command?
thank you so much for your help.
As #Adam said - you've created LastRow and not assigned it to anything.
I'm guessing it's the next row you want to paste your data into, so it should be a Long holding the row number rather than an actual reference to the cell.
In the code below you could qualify the form controls by adding Me., for example Me.RequesterName.Value
https://msdn.microsoft.com/en-us/library/office/gg251792.aspx
Private Sub cmdAdd_Click()
Dim wrkSht As Worksheet
Dim LastRow As Long
'The sheet you want the data to go into.
Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
'You're after the last row number, rather than referencing the range so LastRow is a Long.
'This looks for the last cell containing data in column A (the 1 in 'Cells(...)').
LastRow = wrkSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
'With... End With block. Cells is preceded by a '.' notation - indicating it's referencing the 'With wkrSht'#
'https://msdn.microsoft.com/en-us/library/wc500chb.aspx
With wrkSht
'Using LastRow as row number in cell reference.
.Cells(LastRow, 2) = RequesterName.Value
'Before adding dates to the sheet you might want to check that the
'user entered a date and not rubbish.
.Cells(LastRow, 5) = DateRequestMade.Value
'You could use CDATE to force it to a date - will try and coerce the entered text into a date.
'Note - 1 will be changed to 01/01/1900 (so will need to add extra code to check it really is a date).
.Cells(LastRow, 5) = CDate(DateRequestMade.Value)
End With
End Sub
The first problem is that you've created a Range named LastRow but haven't assigned anything to it.
'Declaration
Dim LastRow As Range
'Assigns the last row based on the last item in Column A
Set LastRow = Range("A" & Rows.Count).End(xlUp).Row
With LastRow
...
End With
The second issue is a minor syntax error in your With LastRow block.
With LastRow
Cells(x,y).Value = "Foo"
End With
Should be
With LastRow
.Cells(x,y).Value = "Foo"
End With
Which is essentially the same as saying LastRow.Cells(x,y).Value = "Foo". Without the "." in front of Cells() VBA will not apply the With to that object, and assume you meant ActiveSheet.Cells()

Cosolidating large excel files, cant go around buffer overflow

I am trying to consolidate multiple large excel files into one single file using the following code
Sub Macro1()
Application.DisplayAlerts = False
Dim Country As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 2
For i = 1 To 50
Windows("Try2").Activate
Country = Worksheets("Names").Cells(i, 1).Value
Workbooks.Open Filename:= "C:path\" & Country & " "
ActiveWorkbook.Sheets("Main").Activate
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
Workbooks(Country).Sheets("Main").Range(Cells(1, 1), Cells(10000, 64)).Copy
Workbooks("Try2").Sheets("Output").Activate
Workbooks("Try2").Sheets("Output").Cells(k, 2).PasteSpecial xlPasteValues
Range(Cells(k, 1), Cells(k + 10000, 1)) = Country
finalrow2 = 10002 + k
k = finalrow2 + 1
Workbooks(Country).Sheets("Main").Activate
Workbooks(Country).Close SaveChanges:=False
Next i
End Sub
However after consolidating 2-3 files excel it is throwing buffer overflow error. We have around 50 files. I am trying to figure out if this is just a problem with excel unable to handle large files or there is something wrong with my code. Is there any way to guide excel to handle larger files sizes?
There's a couple of things here that could be throwing your macro off.
First, you're declaring i, j, and k as the 'integer' data type; problem with that is that the largest possible value an integer can hold is 32,767. If you go above that, you're going to get a buffer overflow.
Second, you're declaring variables that you don't use, and not declaring variables that you do use. As far as I can see, j isn't used anywhere in the code, but finalrow and finalrow2 are used but aren't declared anywhere.
I would suggest you replace your integer data types that could go very high with long data types (long integer). You might also want to use more descriptive names for your integers to make your code easier to read:
Dim iCycler as integer
Dim kStart as long
Dim FinalRow as Long
Dim FinalRow2 as Long
Run through that and see what you get.
EDITED TO ADD:
Here is a complete process that should suit you:
Sub Duplicator()
'Define the source file, sheet, and range
Dim wbkSource As Workbook
Dim shtSource As Worksheet
Dim rngSource As Range
'Define the target file, sheet and range
Dim wbkTarget As Workbook
Dim shtTarget As Worksheet
Dim rngTarget As Range
'Define the sheet with the list of countries
Dim shtControl As Worksheet
'Prepare control integers
Dim iLoop As Integer
Dim lLastRow As Long
'Define the target file as the active workbook
Set wbkTarget = ActiveWorkbook
Set shtTarget = wbkSource.Sheets("Output")
Set rngTarget = shtTarget.Range("A2")
Set shtControl = wbkTarget.Sheets("Names")
'Loop through the list
For iLoop = 1 To 50
'Open the source file and assign it to a variable.
Set wbkSource = Workbooks.Open("C:\path\" & shtControl.Cells(iLoop, 1).Value)
'Assign the source sheet
Set shtSource = wbkSource.Sheets("Main")
'Find the last row of data
lLastRow = shtSource.Range("A" & Rows.Count).End(xlUp).Row
'Use the last row to build a source range variable
Set rngSource = shtSource.Range("A1", "BL" & lLastRow)
'Check that there is space for the copy. If there is not, create a new sheet for the new data
If rngTarget.Row + lLastRow > shtTarget.Rows.Count Then
Set shtTarget = wbkTarget.Sheets.Add
shtTarget.Name = "Output 2"
Set rngTarget = shtTarget.Range("A2")
End If
'Use the size of rngSource to define the size of the target range
Set rngTarget = rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
'Duplicate the values over
rngTarget.Value = rngSource.Value
'Prepare the target range for the next loop
Set rngTarget = shtTarget.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
'Close the source file
wbkSource.Close False
Next iLoop
End Sub
By declaring and using variables throughout, the code should be easier both to write and to read. It should also run quicker, since it's using the range1.value = range2.value structure, which bypasses the rather slow clipboard. It also contains a check to make sure that you're not surpassing 1,048,576 rows of data, which would cause a crash.
quite along the lines of good coding practice Werff already explained to you, you could try this other (commented) code:
Sub Macro1()
Dim outputSht As Worksheet '<--| declare a variable to set your "output" sheet to
Dim countryData As Variant, countryNames As Variant '<--| declare arrays to store "country names" and "country data" in
Dim country As Variant '<-- "countries" looping variable
Application.Calculation = xlCalculationManual '<-- disable calculations
Application.ScreenUpdating = False '<-- disable screen updating
With Workbooks("Try").Worksheets("Names") '<--| reference "country names" worksheet
countryNames = Application.Transpose(.Range("A1", .Cells(.Rows.count, 1).End(xlUp)).Value) '<--| store country names in column "A" from row 1 down to last not empty row
End With
Set outputSht = Workbooks("Try").Worksheets("Output") '<--| set "output" worksheet
For Each country In countryNames '<-- loop through countries stored in 'countryNames'
With Workbooks.Open(FileName:="C:path\" & Country).Sheets("Main") '<--| open current country workbook and reference its "Main" sheet
countryData = .Range("BL1", .Cells(.Rows.count, 1).End(xlUp)).Value '<--| store current country data in 'countryData' array
.Parent.Close SaveChanges:=False '<--| close current country workbook
End With
With outputSht '<--| reference output sheet
With .Cells(.Rows.count, 1).End(xlUp).Offset(1).Resize(UBound(countryData, 1)) '<--|reference its column A range from first empty cell after last not empty cell down to as many rows as current country array has
.Value = country '<--| write current country name in referenced range
.Offset(, 1).Resize(, 64).Value = countryData '<--| write country data array content from column B rightwards
End With
End With
Next country
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
since it uses arrays to store data, it suffers from the arrays maximum size limitation to 65536 rows. If your "countries" workbooks "Main" sheets have more rows than such a limit then different pasting values techniques must be adopted (like between range values)