i want to compare the values in the array taken from a certain column with values of another column
but i am getting an error "subscript is out of range"
is there a better way of doing this?
Dim start As Integer
Dim SrchRngzc As Range, cel As Range, SrchRngyx As Range, cel2 As Range
Set SrchRngzc = Range("zc16:zc500")
Set SrchRngyx = Range("yx16:yx100")
Dim x As Integer, a As Integer, b As Integer, c As Integer
Dim y As Integer
Dim n As Integer
Dim arr(1 To 85) As String
Dim num(1 To 85) As Integer
y = 1
c = 1
'highlight cells that matches
For Each cel In SrchRngyx
arr(y) = cel.Value
y = y + 1
Next cel
For Each cel2 In SrchRngzc
n = 1
For c = 1 To y
If arr(n) = cel2.Value Then ' error occurs here
cel2.Interior.ColorIndex = 4
n=n+1
Exit For
End If
Next c
Next cel2
The code below has 1 For to loop through all cells in column "ZC", and then per cell checks if there is a match somewhere in column "YC", by using the Application.Match.
Code
Option Explicit
Sub MatchColumns()
Dim SrchRngzc As Range, Cel As Range, SrchRngyx As Range
Set SrchRngzc = Range("ZC16:ZC500")
Set SrchRngyx = Range("YX16:YX100")
' loop thorugh cells in column "ZC"
For Each Cel In SrchRngzc
' check if courrent value in column "ZC" has a match in column "YX"
If Not IsError(Application.Match(Cel.Value, SrchRngyx, 0)) Then
Cel.Interior.ColorIndex = 4
End If
Next Cel
End Sub
You have set y to 86 at the end of your first For . . . Next loop. When you try to access arr(86) you get your error. Instead try
y=0
For Each cel in SrchRngyx
y = y+ 1
arr(y) = cel.value
Next
This still starts at 1 but ends at 85.
Related
Here is my current output that my VBscript is generating.
ID DESCRIPTION 1 RECURSIVE_ANALYSIS
CM-1 xxxxxxxxxxxx Issue A
Sub issue a
Sub issue b
Sub issue c
CM-2 yyyyyyyyyyy Issue B
Sub issue a
Sub issue b
This is following VBA code which i have designed for getting the output
Sub CellSplitter1()
Dim Temp As Variant
Dim CText As String
Dim J As Integer
Dim K As Integer
Dim L As Integer
Dim iColumn As Integer
Dim lNumCols As Long
Dim lNumRows As Long
Dim wksNew As Worksheet
Dim wksSource As Worksheet
Dim iTargetRow As Integer
iColumn = 3
Set wksSource = ActiveSheet
Set wksNew = Worksheets.Add
iTargetRow = 0
With wksSource
lNumCols = .Range("IV1").End(xlToLeft).Column
lNumRows = .Range("A65536").End(xlUp).Row
For J = 1 To lNumRows
CText = .Cells(J, iColumn).Value
Temp = Split(CText, Chr(10))
For K = 0 To UBound(Temp)
iTargetRow = iTargetRow + 1
For L = 1 To lNumCols
If L <> iColumn Then
wksNew.Cells(iTargetRow, L) _
= .Cells(J, L)
Else
wksNew.Cells(iTargetRow, L) _
= Temp(K)
End If
Next L
Next K
Next J
End With
End Sub
Here is my expected output
ID DESCRIPTION 1 RECURSIVE_ANALYSIS Issues
CM-1 xxxxxxxxxxxx Issue A Sub issue a
Sub issue b
Sub issue c
CM-2 yyyyyyyyyyy Issue B Sub issue a
Sub issue b
So, can someone help me to figure out to get the expected output.
Any help will be much appreciated.
Thank you
it seems you didn't show the whole story, so here's a guessing:
after your code place the following
With wksNew' reference 'wksNew' sheet
With .Range(.Cells(1, iColumn), .Cells(iTargetRow, iColumn)) ' reference its 'iColumn' column range from row 1 down to its last not empty one
.Insert 'insert a new column before referenced range. now the currently referenced range is one column right shifted (i.e. its in the 4th column of referenced sheet)
.Offset(, -1).Value = .Value ' copy values from referenced range one column to the left (i.e. in the newly created column)
.Offset(, -1).Replace "Sub issue*", "", lookat:=xlWhole 'clear the newly created range cells containing "Sub issue..." (hence, there remains cells with "Issue .." only)
.Replace "Issue *", "", lookat:=xlWhole 'clear the currently referenced range (i.e the one in 4th column) cells containing "Issue..." (hence, there remains cells with "Sub issue .." only)
End With
.Columns.AutoFit 'adjust your columns width
End With
Using Variant array is more simple.
Sub test()
Dim r As Long, c As Integer
Dim j As Integer
Dim k As Integer
Dim wksNew As Worksheet
Dim wksSource As Worksheet
Dim vDB, vSplit, vR()
Set wksSource = ActiveSheet
Set wksNew = Worksheets.Add
With wksSource
c = .Range("IV1").End(xlToLeft).Column
r = .Range("A65536").End(xlUp).Row
vDB = .Range("a1", .Cells(r, c))
For i = 1 To r
vSplit = Split(vDB(i, c), Chr(10))
For k = 1 To UBound(vSplit)
n = n + 1
ReDim Preserve vR(1 To c + 1, 1 To n)
If k = 1 Then
For j = 1 To c - 1
vR(j, n) = vDB(i, j)
Next j
vR(c, n) = vSplit(k - 1)
vR(c + 1, n) = vSplit(k)
Else
vR(c + 1, n) = vSplit(k)
End If
Next k
Next i
End With
Range("a1").Resize(1, c + 1) = Array("ID", "DESCRIPTION 1", "RECURSIVE_ANALYSIS", "Issues")
Range("a2").Resize(n, c + 1) = WorksheetFunction.Transpose(vR)
End Sub
Here is the sample of my current output which the VBscript code is generating.
[https://i.stack.imgur.com/kMpih.png] [1]:
Here is the sample of my expected output
[[1]: https://i.stack.imgur.com/StBqx.png]
Please let me know your suggestions.
Thank you
Firstly I am storing all the data that I want into an array, then I'll compare it with a column; if it matches then i will take the offset of the value and place it into another column.
But here at the array, I am experiencing "invalid qualifier" error. What am I doing wrong?
Sub database_updator()
Dim dataa As Range, dataCel1 As Range, dataj As Range, datacel2 As Range, datazc As Range, datacel3 As Range, SrchRngaa As Range, cel As Range
Dim data As String, datatext As String, PDS_NAME As String, Database_data As String
Dim n As Integer, xx As Integer, z As Integer
Set dataa = Range("a16:a100")
Set datazc = Range("zc17:zc50")
Set SrchRngaa = Range("a16:a100")
Dim arr(1 To 85) As String
x = 16
For n = 1 To 85 'storing data into array
arr(n) = Range("yx" & x).Value
x = x + 1
Next n
' loop thorugh cells in column
For Each dataCel1 In datazc
For n = 1 To 85
If arr(n) = dataCel1.Value Then
datatext = "true"
Exit For
End If
Next n
' check if current value in column has a match in another column
If datatext = "true" Then
PDS_NAME = arr(n).Value ' ERROR OCCURS HERE
Database_data = dataCel1.Offset(0, 2).Value
For Each cel In SrchRngaa
If PDS_NAME = "" Then
Exit For
ElseIf cel.Value = PDS_NAME Then
cel.Offset(0, 2).Value = Database_data
Exit For
End If
Next cel
End If
Next dataCel1
End Sub
PDS_NAME = arr(n).Value
this should be changed to:
PDS_NAME = arr(n)
In the following code, I'm having the hardest time identifying a specific cell in the variable range "rngCell". In the "If" statement, I would like to copy a specific cell in that column or row that the rngCell (the active cell is at) instead of the value of rngCell. I've tried using offset but have been failing. Example: If rngCell is at e42, I may need a value from e2 or a42.
Thank you.
Dim rngCell As Range
Dim lngLstRow As Long
Dim ws As Worksheet, resultsWS As Worksheet
lngLstRow = ws.UsedRange.Rows.Count
Worksheets("FileShares").Select
j = 4
p = 1
q = 4
g = 6
Dim k&
For k = 9 To 50
With ws
For Each rngCell In .Range(.Cells(8, k), .Cells(lngLstRow, k))
For i = LBound(maxKeywords) To UBound(maxKeywords)
If rngCell.Value = maxKeywords(i) And rngCell.Interior.ColorIndex = 3 Then
resultsWS.Cells(g, 2).Offset(j + p, 0) = rngCell.Value
g = g + 1
j = q + p - 5 'Used to start at row 8 and every row after
End If
Next i
Next rngCell
End With
Next k
If rngCell is E42 then:
rngCell.EntireRow.Cells(1) '>>A42
rngCell.EntireColumn.Cells(2) '>>E2
or
ws.Cells(rngCell.Row, 1) '>>A42
ws.Cells(2, rngCell.Column) '>>E2
I have a loop towards the bottom of my code that successfully loops through my data and clears out all rows where Column H = 0.
However, there are several cells in column B displaying #REF!. I would also like this loop to delete those rows in the same manner as it does the 0s in column H.
I think my issue is not knowing how to reference those types of errors. Treating #REF! like a string doesn't appear to be working.
Thank you!
Sub test()
Dim currentSht As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim startCell As Range
Dim r As Integer
Set startCell = Sheets("Sheet1").Range("A1")
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row '<~~ Not sure why, but do not use "Set" when defining lastRow
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For r = 1 To lastRow Step -1
If currentSht.Cells(r, "H").Value = 0 Or currentSht.Cells(r, "B").Text = "#REF!" Then
Rows(r).Select
Selection.EntireRow.Delete
End If
Next r
currentSht.Range(startCell, currentSht.Cells(lastRow, lastCol)).Select
End Sub
I think I see your problem:
For r = 1 To lastRow Step -1
Change that line to
For r = lastrow to 1 Step -1
How about this code:
Sub Delete0()
Dim F As Integer
Dim Y As Integer
Dim RngCount As Range
Set RngCount = ActiveSheet.Range("H:H")
Y = Application.WorksheetFunction.CountA(RngCount)
For F = Y To 1 Step -1
If IsError(ActiveSheet.Range("H" & F)) Then
ActiveSheet.Rows(F).EntireRow.Delete
ElseIf ActiveSheet.Range("H" & F).Value = 0 Then
ActiveSheet.Rows(F).EntireRow.Delete
End If
Next F
End Sub
I've got a range in a text format containing values and numbers. I am trying to assign the numbers only to an array and then I will assign the text values to another array without having to loop through the range. However, this code says - type mismatch?
Sub Igra()
Dim Arr() As Variant
'convert the range values from text to general
Sheets("Sheet1").Range("R32:W32").NumberFormat = "General"
Sheets("Sheet1").Range("R32:W32").Value = Sheets("Sheet1").Range("R32:W32").Value
' assign only the numbers to the array
Arr = Sheets("Sheet1").Range("R32:W32").SpecialCells(xlCellTypeConstants, xlNumbers).Value
End Sub
This should work then
Dim Arr() As Variant
Sheets("Sheet1").Range("R32:W32").SpecialCells(xlCellTypeConstants, xlNumbers).Copy
Sheets("Sheet1").Range("A1").PasteSpecial xlValues
Arr = Range(Range("A1"), Range("A1").End(xlToRight))
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
MsgBox Arr(R, C)
Next C
Next R
Try this
Sub Sample()
Dim ws As Worksheet
Dim Arr() As Variant
Dim rng As Range, cl As Range
Dim n As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("R32:W32")
n = Application.WorksheetFunction.Count(rng)
If n = 0 Then Exit Sub
ReDim Arr(1 To n)
i = 1
For Each cl In rng
If IsNumeric(cl.Value) Then
Arr(i) = cl.Value
i = i + 1
End If
Next cl
'~~> Only for demonstration purpose
For i = 1 To n
Debug.Print Arr(i)
Next i
End Sub