Identifying the iteration of a For Each loop in VBA? - vba

If I have a loop that commences:
For each c in Range("A1:C8")
Is there a property of the placeholder c (c.count, c.value, c.something,...) that identifies the number of times the loop has iterated thus far? I would rather use something like this than including another variable.

Instead of using a "for each c in range" you can do something like this:
Dim c as Long 'presumably you did this as a Range, just change it to Long.
Dim myRange as Range 'Use a range variable which will be easier to call on later
Set myRange = Range("A1:C8")
For c = 1 to myRange.Cells.Count
'Do something to the cell, identify it as myRange.Cells(c), for example:
myRange.Cells(c).Font.Bold = True '<--- replace with your code that affects the cell
Next
This allows you to do the exact same For/Next loop, without including an unnecessary counter variable. In this case, c is a counter but also serves the purpose of identifying the cell being impacted by the code.

You need to count it yourself like this
Dim i as integer
i = 0
For each c in Range("A1:C8")
i = i + 1
Or
Dim i as integer
Dim c as Range
For i = 0 to Range("A1:C8").Count - 1
Set c = Range("A1:C8").Cells(i)

(Revised)
Using Column or Row properties, as appropriate to the direction you are iterating, you can compute an ordinal number on the fly. Thus
For Each c1 in myRange
myOrdinal = c1.row - myRange.row + 1 ' down contiguous cells in one column
myOrdinal = c1.Column - myRange.Column + 1 ' contiguous columns, L2R
Next

Related

Efficient Data Transfer from Excel VBA to Web-Service

I have a large worksheet (~250K rows, 22 columns, ~40MB plain data) which has to transfer its content to an intranet API. Format does not matter. The problem is: When accessing the data like
Const ROWS = 250000
Const COLS = 22
Dim x As Long, y As Long
Dim myRange As Variant
Dim dummyString As String
Dim sb As New cStringBuilder
myRange = Range(Cells(1, 1), Cells(ROWS, COLS)).Value2
For x = 1 To ROWS
For y = 1 To COLS
dummyString = myRange(x, y) 'Runtime with only this line: 1.8s
sb.Append dummyString 'Runtime with this additional line 163s
Next
Next
I get a wonderful 2D array, but I am not able to collect the data efficiently for HTTP export.
An X/Y loop over the array and access myRange[x, y] has runtimes >1min. I was not able to find an array method which helps to get the imploded/encoded content of the 2D array.
My current workaround is missusing the clipboard (Workaround for Memory Leak when using large string) which works fast, but is a dirty workaround in my eyes AND has one major problem: The values I get are formatted, “.Value” and not “.Value2”, so I have to convert the data on server site again before usage, e.g. unformat currency cells to floats.
What could be another idea to deal with the data array?
My thoughts are that you create two string arrays A and B. A can be of size 1 to ROWS, B can be of size of 1 to COLUMNS. As you loop over each row in your myRange array, fill each element in B with each column's value in that row. After the final column for that row and before you move to the next row, join array B and assign to the row in A. With a loop of this size, only put necessary stuff inside the loop itself. At the end you would join A. You might need to use cstr() when assigning items to B.
Matschek (OP) was able to write the code based on the above, but for anyone else's benefit, the code itself might be something like:
Option Explicit
Private Sub concatenateArrayValues()
Const TOTAL_ROWS As Long = 250000
Const TOTAL_COLUMNS As Long = 22
Dim inputValues As Variant
inputValues = ThisWorkbook.Worksheets("Sheet1").Range("A1").Resize(TOTAL_ROWS, TOTAL_COLUMNS).Value2
' These are static string arrays, as OP's use case involved constants.
Dim outputArray(1 To TOTAL_ROWS) As String ' <- in other words, array A
Dim interimArray(1 To TOTAL_COLUMNS) As String ' <- in other words, array B
Dim rowIndex As Long
Dim columnIndex As Long
' We use constants below when specifying the loop's limits instead of Lbound() and Ubound()
' as OP's use case involved constants.
' If we were using dynamic arrays, we could call Ubound(inputValues,2) once outside of the loop
' And assign the result to a Long type variable
' To avoid calling Ubound() 250k times within the loop itself.
For rowIndex = 1 To TOTAL_ROWS
For columnIndex = 1 To TOTAL_COLUMNS
interimArray(columnIndex) = inputValues(rowIndex, columnIndex)
Next columnIndex
outputArray(rowIndex) = VBA.Strings.Join(interimArray, ",")
Next rowIndex
Dim concatenatedOutput As String
concatenatedOutput = VBA.Strings.Join(outputArray, vbNewLine)
Debug.Print concatenatedOutput
' My current machine isn't particularly great
' but the code above ran and concatenated values in range A1:V250000
' (with each cell containing a random 3-character string) in under 4 seconds.
End Sub

VBA Word subscripts in Table

I am trying to add text as subscript in a Table Cell in a Word-Document using VBA.
I currently have this code, it is a part of the loop in which I insert my values into the table.
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.Font.Subscript = False
wordArray = Split(ws.Cells(i, j), "_")
For k = LBound(wordArray) To UBound(wordArray)
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.InsertAfter wordArray(k)
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.Font.Subscript = wdToggle
Next k
So I split the text that is in ws.Cells(i,j) on "_"
This can become an array of length 1,2 or 3
Only the second element of the array must be subscript.
My current code should do that, however, it writes the value into the cell based on the last value of Font.Subscript, so either fully normal or fully subscript.
So what I actually want in my table cell is the following
If the ws.Cells has for example a_b_c then b should be subscript and a and c normally written in the table cell. How do I need to change my code to accomplish that?
Since you haven't provided a mvce you'll need to adapt the following example to your needs - . It's main purpose is to demonstrate how to insert text and format it, which is done in the For loop.
Please note how to declare and instantiate a Table object - this is more reliable and more efficient than repeating ActiveDocument.Tables[index].
Use a Range object to write the data to the table cell. Important is "collapsing" the range so that the content is appended, rather than over-written. You need to write a separate range object for each formatting variation.
The code below checks whether the second member of the array is being written. If yes, it's formatted as subscript, if it's another member, then no subscript.
Sub CellContentWithSubscript()
Dim tbl As Word.Table
Dim rng As Word.Range
Dim wordArray '() As Variant
Dim data As String, k As Long
Set tbl = ActiveDocument.Tables(1)
data = "PartOne_Part two_Part three"
wordArray = Split(data, "_")
Set rng = tbl.Cell(1, 1).Range
rng.Collapse 0
rng.MoveEnd wdCharacter, -1
For k = LBound(wordArray) To UBound(wordArray)
rng.Text = wordArray(k)
If k = 1 Then
rng.Font.Subscript = True
Else
rng.Font.Subscript = False
End If
rng.Collapse 0
Next k
End Sub

Writing a loop in Excel for Visual Basic

How do i write the following code as a loop. I want to copy values from a table in sheet 4 in a row from range (b:17:L17"). is there a more efficient way to do it with loops ?
ActiveSheet.Range("B17").Value = Sheets(4).Range("G8")
ActiveSheet.Range("C17").Value = Sheets(4).Range("G9")
ActiveSheet.Range("D17").Value = Sheets(4).Range("G10")
ActiveSheet.Range("E17").Value = Sheets(4).Range("G11")
ActiveSheet.Range("F17").Value = Sheets(4).Range("G12")
ActiveSheet.Range("G17").Value = Sheets(4).Range("G13")
ActiveSheet.Range("H17").Value = Sheets(4).Range("G14")
ActiveSheet.Range("I17").Value = Sheets(4).Range("G15")
ActiveSheet.Range("J17").Value = Sheets(4).Range("G16")
ActiveSheet.Range("K17").Value = Sheets(4).Range("G17")
ActiveSheet.Range("L17").Value = Sheets(4).Range("G18")
Yes, there is:
ActiveSheet.Range("B17:L17").Value = Application.Transpose(Sheets(4).Range("G8:G18").Value)
You can, using something like this (VB.Net, but may copy easily to VBA):
Dim cell as Integer, c as Integer
cell = 8
For c = 66 To 76
ActiveSheet.Range(Chr(c) & "17").Value = Sheets(4).Range("G" & cell)
cell = cell + 1
Next
The Chr() function gets the character associated with the character code (66-76), and then this value is concatenated with the string "17" to form a complete cell name ("B17", "C17", ...)
I am also incrementing the cell number for G at the same time.
Use this if you really want to use a loop - but there could be better ways, like the answer given by #A.S.H
Solution explanation:
Establish your rules! What is changing in the range for active sheet? The column is going to grow as the for/to cycle does! So, we should sum that to it. What is the another thing that is going to increment? The Range in the other side of the '=' so, by setting an algorithm, we may say that the row is const in the Activesheet range and the column is the on variable on the other side.
Solution:
Sub Test()
Const TotalInteractions As Long = 11
Dim CounterInteractions As Long
For CounterInteractions = 1 To TotalInteractions
'where 1 is column A so when it starts the cycle would be B,C and so on
'where 7 is the row to start so when it begins it would became 8,9 and so on for column G
ActiveSheet.Cells(17, 1 + CounterInteractions).Value = Sheets(4).Cells(7 + CounterInteractions, 7)
Next CounterInteractions
End Sub
This is probably your most efficient solution in a with statement:
Sub LoopExample()
Sheets("Sheet4").Range("G8:G18").Copy
Sheets("Sheet2").Range("B17").PasteSpecial xlPasteValues, Transpose:=True
End Sub

Excel VBA - Nested loop to format excel table columns

I have a macro that so far, adds 4 new table columns to an existing table ("Table1"). Now, I would like the macro to format the 3rd and 4th row as percentage. I would like to include this in the loop already listed in my code. I have tried several different ways to do this. I don't think I quite understand how the UBound function works, but hopefully you can understand what I am trying to do.
I also am unsure if I am allowed to continue to utilize the WITH statement in my nested For loop in regards to me 'lst' variable.
#Jeeped - I'm looking at you for this one again...thanks for basically walking me through this whole project lol
Sub attStatPivInsertTableColumns_2()
Dim lst As ListObject
Dim currentSht As Worksheet
Dim colNames As Variant, r1c1s As Variant
Dim h As Integer, i As Integer
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
colNames = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
r1c1s = Array("=([#[Inbound Talk Time (Seconds)]]+[#[Inbound Hold Time (Seconds)]]+[#[Inbound Wrap Time (Seconds)]])/[#[Calls Handled]]", "=350", "=[#[Call Transfers and/or Conferences]]/[#[Calls Handled]]", "=0.15")
With lst
For h = LBound(colNames) To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If UBound(colNames(h)) = 2 or UBound(colNames(h)) = 3 Then
For i = UBound(colNames(h), 2) To UBound(colNames(h), 3)
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next i
Next h
End With
End Sub
You don't need to nest a second for loop. If you want to set the 3rd and 4th columns to a percentage, you only need to set that when the iteration of the loop (h) is 2 or 3 (remembering that arrays index from 0). You also shouldn't cross arrays for the main loop, and since LBound is in most cases 0 you might as well just use that anyway. Try this:
With lst
For h = 0 To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If h = 2 or h = 3 Then
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next h
End With
To answer the other point in your question, UBound(array) just gives the index of the largest element (the Upper BOUNDary) in the given array. So where you have 50 elements in such an array, UBound(array) will return 49 (zero based as mentioned before). LBound just gives the other end of the array (the Lower BOUNDary), which is generally zero.

Delete entire row when a value exist (With sheets) [duplicate]

I have 2 sheets: sheet1 and sheet2. I have a value in cell A3 (sheet1) which is not constant. And many files in sheets2.
What I would like to do, is when the value in cell A3 (Sheet1) is the same as the value in the column A (Sheet2), it will delete the entire row where is find this value (Sheet2).
This is my attempt. It doesn't work: no rows are deleted.
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
Dim f As String
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(f)
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
End If
My guess is that you're not finding anything with the .Find(). Since you're not checking it for is Nothing you don't know. Also, .Find() retains all the search parameters set from the last time you did a search - either via code or by hand in your spreadsheet. While only the What parameter is required, it's always worth setting the most critical parameters (noted below) for it, you may want to set them all to ensure you know exactly how you're searching.
Dim f As String
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(What:=f, Match:=[Part|Whole], _
LookIn:=[Formula|value])
if not c is Nothing then
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
else
MsgBox("Nothing found")
End If
End If
Go look at the MS docs to see what all the parameters and their enumerations are.
Sub Test()
Dim ws As Worksheet
For x = 1 To Rows.Count
If ThisWorkbook.Sheets("Sheet2").Cells(x, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(3, 1).Value Then ThisWorkbook.Sheets("Sheet2").Cells(x, 1).EntireRow.Delete
Next x
End Sub