Group sheets with names in a string variable - vba

I want to group a number of sheets that has sheet names with in a string variable, the group of sheets will be used to format each sheet within the group.
The string (let's call it, SheetsFormat) contains all sheet names that need to be formatted, each value within the string was added into the dynamic string when it was created.
The question is how to create a group of sheets that reference the SheetsFormat string?
Example of the string contents: "Mon Maint", "Mon Mgnt", "Tue Prod" etc.
The code I used was:
Dim ws as worksheet, ws_group As Worksheets
Set ws_group = Sheets(Array(SheetsFormat))
For Each ws In ws_group
'some staff
Next

Here's a sample procedure to get you going. You can build your array in any number of ways, but the end result will follow this patter--iterating through an array (or similar) to do the same operations on the set of worksheets.
Sub SampleDoSomethingToMultipleSheets()
Dim SheetsFormat(3) As String
SheetsFormat(0) = "Mon Maint"
SheetsFormat(1) = "Mon Mgnt"
SheetsFormat(2) = "Tue Prod"
Dim idx As Integer
For idx = 0 To UBound(SheetsFormat) - 1
With Sheets(SheetsFormat(idx))
' put your code here, e.g.
.Range("A1").Value = "StackOverflow is awesome"
End With
Next idx
End Sub

Here's an example that does what you want. It uses the Split function which splits a string into an array based on a separator.
Sub LoopThroughSheetsString()
Dim SheetsFormat As String
Dim ws As Excel.Worksheet
SheetsFormat = "Sheet1,Sheet2,Sheet3"
'loop through the array created by splitting SheetsFormat on commas
For Each ws In Sheets(Split(SheetsFormat, ","))
Debug.Print ws.Name
Next ws
End Sub
Note that it's one long string with double-quotes only at the beginning and end.

Related

Looping through columns to get column numbers based on headers

I have a template with a set number of columns (170) and title headers (row 1 cell name's). This is always the same, until users add columns in between (they're instructed not to change headers). The idea is to make it tamperproof as far as the adding of columns is involved.
I'd like to make variables to hold some of the headers (with the capacity to hold all) and check these with the template to find out the column number (in a loop I reckon). It's probably wisest to make a function to call upon it?
Dim ColHeader1Str as string 'literal row 1, column 1 value (which is always
'the same string and position in the template)
Dim iColHeader1 as integer 'holds the (to be set) value of the column number
Set ColHeader1Str = "ColHeader1"
Now I'd like a loop where it loops trough all the columns (last column = 200) and checks to see what the column number is that matches the ColHeader1Str and store this in the iColHeader1
So something like:
Function find_columnNmbr
Dim i As Integer
For i = 1 To 200 Step 1
If 'ColHeader1Str matches actual column header name
'set found integer as iColHeader1 and so forth
Exit For
End If
Next
End Function`
I know I'm missing a few steps and I'm hoping you guys can help me out.
Update: The template has set column headers. When users interact with it a result could be that columns shift position, or they add more. I have a workbook that needs to load data out of the user's altered template.
I.E. The template has columns 1, 2, 3, 4 and the names are column1, column 2 etc. A user ads a random column so now there are 5. The loop needs to loop through the names of the column headers and identify the column number of the original template columns 1, 2 etc based on a string variable with the original names, which I've hard coded beforehand. These are public constants.
What function LookForHeaders do: input a string, then search for the string in usersheet.range(1:1). If it is found, return the column number of that cell, otherwise it returns 0.
Private Function LookForHeaders(ByVal headerName As String) As Long
Dim rng As Range
Dim userSheet As WorkSheet
Set userSheet = 'userSheet here'
On Error GoTo NotFound
LookForHeaders = userSheet.Range("1:1").Find(headerName).Column
Exit Function
NotFound:
LookForHeaders = 0
End Function
Private Sub Test()
Dim rng As Range
Dim template As WorkSheet
Set template = 'template here'
For Each rng In template.Range(Cells(1,1), Cells(1,200))
iColHeader1 = LookForHeaders(rng.Value)
'Do something with iColHeader1
Next rng
End Sub
Not sure what your looking for but here is example
Option Explicit
Public Sub Example()
Dim LastCol As Long
Dim i As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For i = 1 To LastCol
If Cells(i) = "Name" Then
Debug.Print Cells(i).Address
End If
Next
End Sub

How to reference MS Word table of contents page numbers with Excel VBA?

I am trying to use the page numbers to the right-hand side of a table of contents object in Word in some VBA code. I can access the array storing the text associated with these page numbers using GetCrossReferenceItems(wdRefTypeHeading) but cannot seem to get at the page numbers themselves. None of the GetCrossReferenceItems constants listed here seem relevant.
Is there a way to reference these page numbers? Thanks!
I'm not a "Worder" so here is what I came up to:
Function GetPagesNumber(doc As Document) As Long()
Dim i As Long
Dim myRng As Range
Dim myHeadings As Variant
With doc
Set myRng = .Content
myRng.Collapse Direction:=wdCollapseEnd
myHeadings = .GetCrossReferenceItems(wdRefTypeHeading)
ReDim pages(1 To UBound(myHeadings)) As Long
For i = 1 To UBound(myHeadings)
myRng.InsertCrossReference ReferenceType:=wdRefTypeHeading, ReferenceKind:=wdPageNumber, ReferenceItem:=i
With .Paragraphs(ActiveDocument.Paragraphs.count).Range
myRng.SetRange Start:=.Start, End:=.End - 1
End With
pages(i) = CLng(myRng.Text)
Next i
End With
myRng.Delete
GetPagesNumber = pages
End Function
to be used like follows:
Option Explicit
Sub main()
Dim myPagesNumber() As Long
myPagesNumber = GetPagesNumber(ActiveDocument) '<-- store index pages numbers in myPagesNumber
End Sub
Instead of using;
myHeadings = .GetCrossReferenceItems(wdRefTypeHeading)
You can also use;
Dim myField As Field
Set myField = ActiveDocument.TablesOfContents(1).Range.Fields(1)
myHeadings = Split(myField.Result.Text, Chr(13))
This will return an array of strings, with within the last characters of the array the page number of the heading. Use pgnr = CInt(Right(myHeadings (i), Len(myHeadings (i)) - InStrRev(myHeadings (i), Chr(9)))) to get the pagenumber.
What would be better is to first split myHeadings into rows with Chr(13) as delimiter and then split into columns with Chr(9) as delimiter.
So the whole table of contents in an array.

Getting the cell value of two string variables

I have a 2D chart in Excel. I need to get the value of a cell using two string variables. The chart looks like this:
Document person1 person2
Text1 5 8
Text2 2 1
Text3 9 6
After looking online I am finding this difficult because:
the values are strings, not integers;
the strings will change depending on which person and document combination comes up.
This should be the only code that is relevant:
Dim document as string
Dim person as string
Dim oExcel as excel.application
Dim oWB as workbook
Set oExcel = New Excel.application
Set oWB = oExcel.Workbooks.open. ("C:")
oExcel.Visible = True
oWB.Sheets ("sheet1").Cells(documemt, person)
Assuming that document and person are string variables that hold string representations of integers (e.g. document = "1", person = "2") then something like
oWB.Sheets ("sheet1").Cells(val(document), val(person))
will work. If the contents of the string variables are more complicated then you would need to do some parsing of those strings.
Assuming by "2d Chart" you mean a table in a Worksheet, and that person would be the full text "person1", or "person2", etc. and likewise for document, then perhaps this function will do the trick.
Function FindDocPerson(person As String, document As String) As Variant
Const MatchExact As Integer = 0
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim table As Excel.Range
Set table = ws.UsedRange
Dim docRange As Excel.Range
Set docRange = table.Columns(1).Offset(1, 0).Resize(table.Columns(1).Rows.Count - 1)
Dim personRange As Excel.Range
Set personRange = table.Rows(1).Offset(0, 1).Resize(1, table.Columns.Count - 1)
Dim personIndex As Long
Dim docIndex As Long
On Error GoTo errHandler
personIndex = Application.WorksheetFunction.Match(person, personRange, MatchExact) + 1
docIndex = Application.WorksheetFunction.Match(document, docRange, MatchExact) + 1
FindDocPerson = table.Cells(docIndex, personIndex).Value2
Exit Function
errHandler:
FindDocPerson = VBA.CVErr(Excel.xlErrNA)
End Function
calling syntax:
Dim result As Variant
result = FindDocPerson("person2", "text1")
If Application.WorksheetFunction.IsError(result) Then
' handle it
Else
' found it
End If
There is a typo in your code,
oWB.Sheets ("sheet1").Cells(documemt, person)
documemt should be document
All that aside though it is unclear what you want to do, can you give a little more description please?
All we know is you need to get the value of a cell using two string variables and that it could be a string or a number. The code you posted doesn't give much more of a hint to your goal.
To convert between strings and numbers you can use CLng to convert to a long number or CStr to convert to a string. eg CLng("3") = 3 and CStr(3) = "3"
In your code this:
Set oWB = oExcel.Workbooks.open. ("C:")
Doesn't work because you are trying to open a workbook without specifying a name, I also note the ("C:") is spaced far to the right of the command call which leads me to believe this is has been typed freestyle ie not in the VBE. This makes it even harder to decode into your requirements.
Lastly, this code:
Set oExcel = New Excel.application
Why are you starting another session of Excel from Excel VBA code? Is this code somewhere other than Excel ie Outlook / Access / PowerPoint / Word / Business Objects etc etc.

How to find and replace multiple values in Excel?

I have for example a column of 18000 domains and another list with 210.000 domain which those 18000 domains can be found. I need to do smth like CTRL + H, for find and replace, and in the find field I need to add the entire 18000 domains: smth like * domain1.com *, * domain2.com *, * domain3.com * and replace them with blank space. Tried this with find and replace from excel but it doesn't work to add more than 1 value in the Find field. How can i do it for multiple values?
VBA solution
You will need to change the two sheet references (data and edit sheet) data = source, edit = destination. I've also set the replace string to a variable so you can change this from an empty string if required.
If you need any other logic (ie Trim the strings before compare or a change to the strings case comparison) the code should be reasonably easy to tweak.
Hope this helps.
Sub ReplaceValues()
Dim dataSht As Worksheet
Dim editSht As Worksheet
Dim dataRange As Range
Dim dataColumn As Long
Dim editColumn As Long
Dim dataEndRow As Long
Dim editEndRow As Long
'sheet that holds all the values we want to find
Set dataSht = Sheet2
'sheet we want to edit
Set editSht = Sheet1
Dim replaceValue As String
'replace value is empty string
replaceValue = ""
'set the column of the data sheet to A
dataColumn = 1
'set the colmun of the sheet to edit to A
editColumn = 1
dataEndRow = dataSht.Cells(dataSht.Rows.count, dataColumn).End(xlUp).Row
editEndRow = editSht.Cells(editSht.Rows.count, editColumn).End(xlUp).Row
'this is the range of the data that we're looking for
Set dataRange = dataSht.Range(dataSht.Cells(1, dataColumn), dataSht.Cells(dataEndRow, dataColumn))
Dim count As Long
Dim val As String
For i = 1 To editEndRow
val = editSht.Cells(i, editColumn).Value
count = Application.WorksheetFunction.CountIf(dataRange, val)
If count > 0 And Trim(val) <> "" Then
editSht.Cells(i, editColumn).Value = replaceValue
End If
Next i
End Sub
You can use wildcards with find/replace. So in your situation you should be able to use something like
domain* in the find what Field and nothing in the Replace field

Change delimited by comma procedure to fill combobox with range from Excel Sheet

The procedure below worked fine for me for a while. However, now the data has changed somewhat. The data is names and they are formatted as Last Name, First Name. Unfortunately, my procedure below was formatted to delimit by comma so what is doing is Last name First Name. I do not want to do that, I would like to keep it as original. How can I change the procedure below to do just that?
Dim xlRng As Excel.Range
Dim strRngArr As String
Dim strChkRange As String
Try
xlWB = CType(Globals.ThisWorkbook.Application.ActiveWorkbook, Excel.Workbook)
xlWS = DirectCast(xlWB.Sheets("allPositionsAnnualized"), Excel.Worksheet)
xlRng = DirectCast(xlWS.Range("B6", xlWS.Range("B6").End(Excel.XlDirection.xlDown)), Excel.Range)
strRngArr = String.Empty
strChkRange = CStr(xlWS.Range("B6").Value)
If (String.IsNullOrEmpty(strChkRange)) Then
cmbSelectPosition.Enabled = False
Else
'Build a string array delimited by commas
For i As Integer = 1 To xlRng.Rows.Count
Dim xlRngCell As Excel.Range = DirectCast(xlRng.Rows(i), Excel.Range)
strRngArr &= DirectCast(xlRngCell.Value.ToString, String) & ","
Next
strRngArr = strRngArr.Remove(strRngArr.Length - 1, 1)
cmbSelectPosition.Items.AddRange(strRngArr.Split(","c))
xlRng = Nothing
xlWS = Nothing
End If
Catch ex As Exception
MsgBox("There no positions available to select", CType(vbOKOnly, MsgBoxStyle), "Empty Selection")
End Try
I tried changing the two lines to:
strRngArr &= DirectCast(xlRngCell.Value.ToString, String)
and
cmbSelectPosition.Items.Add(strRngArr.ToString)
Which should have worked, but instead I only got the first item of my array and it was formatted as Last Name, First NameLastName.
From your comments, I understand that what you want is to replace the loop and the line where the Combobox is being populated with this:
For i As Integer = 1 To xlRng.Rows.Count
cmbSelectPosition.Items.Add(DirectCast(xlRng.Rows(i), Excel.Range).Value)
Next