scan a cell, with 2 variables ( cells(i,j) ) - excel

My string 'strings' does not get any data from the lines where it was supposed to get the data from the cell ( corY, i ).
Here is my code:
Dim strings As String
corY = 2
For i = 5 To 20
strings = ActiveWorkbook.ActiveSheet.Range(Cells(corY, i)).Value
MsgBox (strings)
Next i

The problem is the use of "range" and then "cells". This works for me with a strings in the "B" column of excel.
Sub test5()
Dim strings As String
Dim k As Integer
k = 5
i = 2
corY = 2
For i = 2 To k
strings = ActiveWorkbook.ActiveSheet.Cells(i, corY).Value
MsgBox (strings)
Next i
End Sub

Replace:
strings = ActiveWorkbook.ActiveSheet.Range(Cells(corY, i)).Value
with:
strings = ActiveWorkbook.ActiveSheet.Cells(corY, i).Value
NOTES:
A single Cells() inside Range() does not work. However, here are some examples of setting a range that will work:
Sub examples()
Dim r As Range
Set r = Workbooks("qwerty.xlsm").Worksheets("Junp").Range("A1:B15")
Set r = Worksheets("Junp").Range("A1:B15")
Set r = Range(Cells(1, 1), Cells(15, 2))
Set r = Range("Junp!A1:B15")
End Sub

By using something like the following you get a feedback which range is actually displayed:
Option Explicit
Sub ShowCells()
Dim myString As String
Dim myRange As Range
'Dim iCt As Integer, corY As Integer
Dim iCt As Long, corY As Long
corY = 2
For iCt = 5 To 20
Set myRange = ActiveWorkbook.ActiveSheet.Cells(corY, iCt)
myString = myRange.Value
MsgBox (myRange.Address & ":" & myString)
Next iCt
End Sub

Related

VBA Code: How would you split a string in a cell into sections and displaying those section in a new column using offset function

I am trying to find a way that takes a player's name from cell A2 which in that cell reads (Name, Position, School) and splitting their name, position, and school in a different columns using the offset command. The problem I am having is when I split the cell it also splits the name and I need the name to stay together. For example, Jaylen Coleman RB Duke It splits it into "Jaylen" "Coleman" "RB" "Duke" when I need it to split into "Jaylen Coleman" "RB" "Duke" and then offset those splits 12 columns over.
Sub ParseName()
Dim ACC As Worksheet
Dim lastRow As Long
Dim PlayerPosition As Range
Dim dataList As Range
Dim arrData As Variant
Dim i As Variant
Set ACC = ThisWorkbook.Worksheets("ACC Statistics")
lastRow = ACC.Cells(ACC.Rows.count, "A").End(xlUp).Row
Set dataList = ACC.Range("A1").Resize(lastRow, 1)
For Each PlayerPosition In dataList
arrData = Split(PlayerPosition.Value)
For i = LBound(arrData) To UBound(arrData)
ACC.Cells(PlayerPosition.Row, i + 12).Value = arrData(i)
Next
Next
End Sub
Try this I've added random positions RR and ZZ, just use | as an "or"
Sub rege()
With CreateObject("vbscript.regexp")
.Pattern = "(.+) (RB|RR|ZZ) (.+)"
With .Execute("Jaylen X. Coleman RB Duke")
If .Count > 0 Then
If .Item(0).Submatches.Count = 3 Then
MsgBox .Item(0).Submatches(0) & vblf & _
.Item(0).Submatches(1) & vblf & _
.Item(0).Submatches(2)
End If
End If
End With
End With
End Sub
Your code should look like this (If you are not a mac user :)
Sub ParseName()
Dim ACC As Worksheet
Dim lastRow As Long
Dim PlayerPosition As Range
Dim dataList As Range
Dim arrData As Variant
Dim i As Variant
Set ACC = ThisWorkbook.Worksheets("ACC Statistics")
lastRow = ACC.Cells(ACC.Rows.Count, "A").End(xlUp).Row
Set dataList = ACC.Range("A1").Resize(lastRow, 1)
With CreateObject("vbscript.regexp")
.Pattern = "(.*) (RB|QB|WR) (.*)"
For Each PlayerPosition In dataList
With .Execute(" " & PlayerPosition.Value & " ")
If .Count > 0 Then
If .Item(0).Submatches.Count > 0 Then
For i = 0 To .Item(0).Submatches.Count - 1
ACC.Cells(PlayerPosition.Row, i + 12).Value = Trim(.Item(0).Submatches(i))
Next i
End If
End If
End With
Next
End With
End Sub
Add all your positions in Pattern string in RB|QB|WR part just use | as a separator

How to copy array while removing last character and obtain result as double

I have a table of data in format "numberletter" i.e. 1X, 2.5X, -5X etc. What I am trying to do is to grab the data, remove last character from each cell(there is always only one letter at the end of the value), multiply the result by a constant value and paste it back to a different cells.
Right now, with code below, I am able to get values from first table copied to the second table with last letter removed but the result is string instead of number.
Dim vData
Dim n As Long
Dim r As Long
vData = Range("E6:J500").Value
For n = 1 To UBound(vData, 1)
For r = 1 To 6
If Len(vData(n, r)) <> 0 Then vData(n, r) = Left$(vData(n, r), Len(vData(n, r)) - 1)
Next r
Next n
Range("R6:W500").Value = vData
I've tried to add function below, but I am not able to make it work with my previous code due to mismatch error. Any help would be appreciated.
Function ConvertArray(arrStr() As String) As Double()
Dim strS As String
Dim intL As Integer
Dim intU As Integer
Dim intCounter As Integer
Dim intLen As Integer
Dim arrDbl() As Double
intL = LBound(arrStr)
intU = UBound(arrStr)
ReDim arrDbl(intL To intU)
intCounter = intL
Do While intCounter <= UBound(arrDbl)
arrDbl(intCounter) = CDbl(arrStr(intCounter))
intCounter = intCounter + 1
Loop
ConvertArray = arrDbl
End Function
There may be another better way, but I find .Evaluate an interesting option which in this case could work for you.:
Sub Test()
Dim cnst As Long: cnst = 10
With ThisWorkbook.Sheets("Sheet1") 'Change accordingly
.Range("R6:W500") = .Evaluate("IFERROR(IF(ROW(1:500),LEFT(E6:J500,IF(ROW(1:500),LEN(E6:J500)-1)),"""")*" & cnst & ","""")")
End With
End Sub
Or with a little bit more flexibility with variable ranges:
Sub Test()
Dim rng1 As Range, rng2 as range, cnst As Long
With ThisWorkbook.Sheets("Sheet1") 'Change accordingly
Set rng1 = .Range("E6:J500")
Set rng2 = .Range("R6:W500")
cnst = 10
rng2.Value = .Evaluate("IFERROR(IF(ROW(1:500),LEFT(" & rng1.Address & ",IF(ROW(1:500),LEN(" & rng1.Address & ")-1)),"""")*" & cnst & ","""")")
End With
End Sub
The IFFERROR is in there because you seem to check your range for length above 0 too.
Here you can find why I used ROW(1:500) in .Evaluate:).
The Type Mismatch error is caused because Range.Value returns a variant array not a string array. It is also a 2D Array.
Val() can be used by itself to return the string value as long as the left part of the string contains the value.
Function ConvertArray(arrStr() As Variant, Multiplier As Double) As Double()
Dim results() As Double
ReDim results(1 To UBound(arrStr), 1 To UBound(arrStr, 2))
Dim r As Long, c As Long
For r = 1 To UBound(arrStr)
For c = 1 To UBound(arrStr, 2)
results(r, c) = Val(arrStr(r, c)) * Multiplier
Next
Next
ConvertArray = results
End Function
Sub Test()
Dim data() As Variant
data = Range("E6:J500").Value
Range("R6:W500").Value = ConvertArray(data, 10)
End Sub
Sub Prep()
Range("E6:J500").Formula = "=RandBetween(1,1000)&""X"""
Range("E6:J500").Value = Range("E6:J500").Value
End Sub
You need the VBA Val(String) function. This will take the numerics from your string until it finds a letter. It does a bit more than that as described here.
So you could replace your:
For r = 1 To 6
If Len(vData(n, r)) <> 0 Then vData(n, r) = Left$(vData(n, r), Len(vData(n, r)) - 1)
Next r
With:
For r = 1 To 6
vData(n, r) = Val(vData(n, r)
Next r

VBA. To see which Column A entries do not appear in Column B

I am trying to write VBA code to determine which entries in column A do not appear in column B, and then print these entries.
Sub Checker()
Dim endrow As Integer
endrow = 8
For i = 2 To endrow
Next i
End Sub
I think the next step is to use an if statement with the worksheet function match, to first take the "345A" and compare it with each entry in Column B in turn. But haven't any success implementing.
Any help would be appreciated, thanks.
A slow but thorough way:
Sub compareColumns()
Dim r As Range
Dim s As Range
Dim firstCol As Range
Dim secCol As Range
Dim match As Boolean
Set firstCol = Range("A1:A8")
Set secCol = Range("B1:B8")
For Each r In firstCol
match = False
For Each s In secCol
If r.Value = s.Value Then
match = True
Exit For
End If
Next s
Debug.Print r.Address & "has a match = " & match
Next r
End Sub
Option Explicit
Sub Test()
Dim LR As Long, i As Long
LR = 8
For i = 2 To LR
If WorksheetFunction.CountIf(Range("A" & i), Range("B:B")) = 0 Then
Debug.Print Range("A" & i)
End If
Next i
End Sub

Excel VBA find match and return alternating values

I am having trouble trying to include something into a macro I am building. I need it to search through column C
for cells that say "start trans" and in one column over (d)- the first value will be equal to zero, next instance should be 100, next instance 0 next instance 100 so on until the end of the data.
Instances are not always every 4th line and I have other zeros that I want it to overlook.
Thank you for any help!
How about this one:
Sub GoGoGo()
Dim l As Long: Dim i As Long
Dim b As Boolean
With ActiveSheet
l = .Cells(.Rows.Count, "C").End(xlUp).Row
For i = 5 To l
If .Cells(i, "C").Value2 = "start trans" Then .Cells(i, "D").Value2 = b * -100: b = Not b
Next i
End With
End Sub
Try this.
Sub test()
Dim rngDB As Range, rng As Range
Dim n As Long, Result As Integer
Set rngDB = Range("c5", Range("c" & Rows.Count).End(xlUp))
For Each rng In rngDB
If rng = "start trans" Then
n = n + 1
If n Mod 2 Then
Result = 0
Else
Result = 100
End If
rng.Offset(0, 1) = Result
End If
Next rng
End Sub

VBA - Define range variables through looping

I'm wondering if it's possible to define range variables through a for..next loop?
Something like that
Public Sub DefineRanges()
Dim i As Long
Dim rngLine1, rngLine2 As Range
For i = 1 To 2
Set Replace("rngLinex", "x", i) = ThisWorkbook.Sheets("Sheet1").Range("A" & i)
Next i
End Sub
or like that
Public Sub DefineRanges()
Dim i As Long
Dim rngLine1, rngLine2 As Range
For i = 1 To 2
Set rngLine & i = ThisWorkbook.Sheets("Sheet1").Range("A" & i)
Next i
End Sub
Thank you in advance.
As #JohnColeman stated use an array of ranges:
Sub defineranges()
Dim i As Long
Dim RngArr(1 To 2) As Range
For i = 1 To 2
Set RngArr(i) = ThisWorkbook.Worksheets("Sheet1").Range("A" & i)
Next i
For i = 1 To 2
Debug.Print RngArr(i).Value
Next i
End Sub

Resources