## VBA to get values from a listbox on a spreadsheet in Excel

I have a listbox named ListBox1 on Sheet1 of an excel workbook.

Everytime the user selects one of the items in the list, I need to copy its name to a variable named strLB.

So, if I have Value1, Value2, Value3, Value4 and the user selects Value1 and Value3, I need my strLB to come out as Value1,Value3. Pretty straightforward.

I tried doing that post hoc with:

For i = 1 To ActiveSheet.ListBoxes("ListBox1").ListCount
If ActiveSheet.ListBoxes("ListBox1").Selected(i) Then strLB = strLB & etc.etc.
Next i

But this is very slow (I actually have 15k values in my listbox). This is why I need to record the selection in real time and not in a cycle, after the user is done inputting.

Of course I’m going to also need a way to check if the user removed any of the previous selection.

Hope you guys can help!!

## Excel 2010: VBA to delete columns with headers containing text across multiple tables/worksheets

I have macros to dynamically create columns (via an “Add” button) in tables across multiple sheets in my workbook, in some cases on sheets containing multiple tables. I would like to also have a “Remove” button that finds all columns containing text “toolname” in all tables in the workbook and deletes them.

I’ve tried a few different loops but am not sure how to go about actually finding and deleting columns based on said text, whether it should be a structured reference or a range, etc. Pretty big vba noob here so any help in the right direction would definitely be appreciated!

## Scrapping Data Tables VBA Excel

I created a macro that collect Data from Table in a web Page and transfert it to Excel , the code works great

but the data isn’t organized and it is moving to the right table after table in the Excel Data and Also i only make the search of the Data with only one value .

So What I want :

1/ Modifiy the code “2” to organize the data table under the other

2/ Making multiple seach with data stored in another sheet i only make a single search with value “k20442”

This My code :

Sub extract()

Dim IE As Object, obj As Object
Dim itm As IHTMLElement
Dim r As Long, c As Long, t As Long
Dim elemCollection As Object
Dim eRow As Long
Dim oHtml As HTMLDocument
Dim i As Long
Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet
'add the microsoft Internet Controls
Set IE = CreateObject("InternetExplorer.Application")

With IE
.Visible = True
.navigate "http:"

While IE.Busy Or IE.readyState <> 4: DoEvents: Wend
'we ensure that the web Page is loaded completely
Set itm = IE.document.getElementsByName("searchById")(0)
If Not itm Is Nothing Then itm.Value = "k20442"
Set doc = IE.document

Set tags = IE.document.getElementsByTagName("input")

For Each tagx In tags
If tagx.src = "http:mh/image/button_search.gif" Then
tagx.Click
End If
Next

'On Error Resume Next

While IE.Busy Or IE.readyState <> 4: DoEvents: Wend

Set oHtml = New HTMLDocument
oHtml.body.innerHTML = IE.document.body.innerHTML

Set elemCollection = oHtml.getElementsByClassName("TableContent")
'Debug.Print elemCollection.Length

With ws
Sheets("Feuil1").Range("A1:AK500").ClearContents
End With

With ws
i = 1
r = 1
For Each tb In elemCollection
For Each ele In tb.getElementsByTagName("TD")
Sheets("Feuil1").Cells(r, i) = ele.innerText
i = i + 1
Next
r = r + 1
Next
End With

'For t = 0 To (elemCollection.Length - 1)
'For r = 0 To (elemCollection(t).Rows.Length - 1)
'For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)

'With ws
'Sheets("Feuil1").Cells(r + 1, c + 1) =
'elemCollection(t).Rows(r).Cells(c).innerText
'DoEvents
'End With
'
'Next c
'Next r
'Next t

End With
IE.Quit
Set IE = Nothing
MsgBox "Done"
End Sub

the code 2 for the second

With ws
i = 1
r = 1
For Each tb In elemCollection
For Each ele In tb.getElementsByTagName("TD")
Sheets("Feuil1").Cells(r, i) = ele.innerText
i = i + 1
Next
r = r + 1
Next
End With

this an example of html table

Can anyone light me in solving this

Ps: the site that I’m working on is Local For entreprise internal

## Making pivot items visible from a fixed range

I have a table in Sheet “Code”. In column C i have some country code like DE,FR,GB…I just want to select all the values and make at as visible in pivot table which is available in the Main sheet. I used the code below but not working and not showing error. Help me to change my code.

Sub pivot()
Dim wst,ws As Worksheet
Dim arr1() As String
Dim j As Long

Set wst = Sheets("Code")
LastCol = wst.Cells(wst.Rows.Count, 3).End(xlUp).Row
ReDim Preserve arr1(1 To LastCol)
For j = 1 To LastCol
arr1(j) = wst.Cells(j, 3).Value
Next j

Set ws = Worksheets("Main")
ws.PivotTables("MainTable").PivotFields("Country Code").ClearAllFilters
With ws.PivotTables("MainTable").PivotFields("Country Code")
For Each pi In .PivotItems
pi.Visible = InStr(1, arr1, pi.Name) > 0
Next
End With

End Sub

## I cannot close Userform in another Userform

I have created Userform1, where Userform2 (in VBA written calendar) will be opened after you click on TextBox1. You choose the date then you can close the calendar

Fun fact:
in 32 bit MS Office I can close Userform2 without any problem. it runs normal
in 64 bit MS Office I cannot close Userform 2 and the process will not continue.

.Hide and Unload Userform2 or Unload Me do not work.

I have read about this issue but there were no solution.

## Sumif formula in VBA

I have a macro which adds two new worsheets ws2 and ws3

The following vlookup formula works fine

With ws3.Range("E4:E" & LastRow)
.Formula = "=VLOOKUP(A4," & ws2.Name & "!A:C,3,FALSE)"
End With

But when I want to add another formula to the column F which is excel formula SUMIF(January!G:G,A:A,January!H:H) it does not work when I rewrite as follows

With ws3.Range("F4:F" & LastRow)
.Formula = "=SUMIF(" & ws2.Name & " ! G:G, A:A ," & ws2.Name & " !H:H)"
End With

I asked the same question in the Mr Excel forum, but have not received a reply yet.

https://www.mrexcel.com/forum/excel-questions/1048876-vba-adding-formulas-referencing-new-sheet.html

## Save as txt with name and file location based on cell value

i need to export as txt some sheets , i can’t do it . I try it in that way but don’t go to the right file location :

Dim filePath As String
Dim fileName As String

filePath = Sheet1.Range("B3").Value

fileName = Sheet22.Range("N3").Value

Sheet14.Select
ActiveWorkbook.SaveAs fileName:= _
fileName,
FileFormat:= _
xlText, CreateBackup:=False

it’s that correct ?

## Late binding creating object VBA

I would like to use late binding to use the following reference :

Name : “Microsoft Windows Common Controls 6.0 (SP6)”

Filepath : “C:\Windows\System32\MSCOMCTL.OCX”

GUID : “{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}”

I understood thanks to this topic the difference between early and late binding:

This is early binding: Dim olApp As Outlook.Application Set olApp =
New Outlook.Application

And this is late binding: Dim olApp As Object Set olApp =
CreateObject(“Outlook.Application“)

However, I do not know how to find my object name (see bold quoted text above). Every example on the internet uses Powerpoint or Outlook.application.

Any help? Thanks

## CommandText Not Runtime error 1004 in office 2013

I have a code that should update the date in a sql query of a connection in excel. The date determines the table the data will come from. The code works without a problem in office 2016 on windows 10. However, I get runtime error

1004: “application-defined or object-defined error””

on .CommandText line when I run the same macro in office 2013 on windows 8.

Any ideas on how to solve this problem?

Sub change_date()

Dim a, x, year, month, day As String, datebox As Variant

'Get the day, month and year from name of the workbook
x = ActiveWorkbook.Name
year = Mid(x, 1, 4)
month = Mid(x, 5, 2)
day = Mid(x, 7, 2)

'Ask user if he/she wants to change the date
datebox = InputBox("Is the report date " & _
day & "." & month & "." & year & _
"?" & vbNewLine & vbNewLine & _
"If not, please enter the report date below as YYYY-MM-DD and click 'OK'." & vbNewLine & vbNewLine & _
"If that is the correct date, click 'OK' or 'Cancel' without entering anything below")
If datebox = "" Then
x = year & "-" & month & "-" & day
Else
x = datebox
End If

'Update the query with the report date
With ActiveWorkbook.Connections("postgres y_original_customer_info").ODBCConnection
a = "SELECT * FROM public.f_customers_with_pllm_and_gkh('"
a = a & x
a = a & "')"

'Following line gives Runtime error 1004
.CommandText = a

'Following also gives error
'.CommandText = Array("SELECT * FROM public.f_exposures_with_sllp_and_cqs('" & x & "')")

.Refresh
End With
End Sub

I can’t understand why the code doesn’t work in office 2013. Any help would be appreciated.

## Read File From Sharepoint

I’m writing a script where I wish to write an HTML doc to a string from sharepoint.

Dim Content As String
Dim strShare As String: strShare = "\\link\to\share.html"
Dim iFile As Integer: iFile = FreeFile

Open strShare For Input As #iFile
Content = Input(LOF(iFile), iFile)
Close #iFile

However, I find I get a “path/file access error” every time I run the script for the first time upon boot. Once I visit “\link\to\share.html” in IE for the first time, the path begins to resolve in the VBA script.

My only thought is that IE is performing some sort of “DNS Cache” that VBA can’t do. Currently my workaround is to catch the error and force the URL to open in IE the first time the script is run. After that, every other HTML file under that share loads fine.

As a test, I tried switching between from what I understand is http:// formatting (forward slash) and WebDAV formatting (\\ formating), and only the backslash separated paths ever work. I also tried to resolve the share to an IP and try it that way, but that never worked.

My last thought is to try mapping the share to a drive letter name and then specifically accessing the share with G:\link\to\mapped\share.html. But I don’t see this as an elegant solution, and wonder if it will receive the same error any way.

Is there something blatant that I do not understand about WebDAV, Windows file handling, and VBA file inputs? There’s something weird going on under the hood with resolving that shared domain, and I can’t seem to debug it.