I need to be able to tell if a certain range of 20 cells has content, if so then move to the next 20 cells directly in the range below. Example(Sue-do): If Range(A1-B10) has items, then move to range (A11-B20). There can only be a max of 20 ranges(so 400 cells). I have code that populates these cells, but it overwrites if more than 1 item is chose to collect data from.
I think you want something like that:
dim Emptiness as boolean
dim MyRange as range, Cell1 as range
dim i as integer, j as integer
set myrange=range("A1:B10")
for i=0 to 19
j=10*i
set myrange=myrange.offset(j,0)
Emptiness=true
for each cell1 in myrange
if isempty(cell1)=false then
emptiness=false
exit for
else
emptiness=true
endif
next cell1
if emptiness=true then
'your code that populates
endif
next i
you could try this
Option Explicit
Sub main()
Dim i As Long
With Worksheets("mySheet").Range("A1:B20") <--| change "MySheet" with your actual sheet name and "A1:B20" with your actual "initial" range
For i = 0 To 19
If WorksheetFunction.CountA(.Offset(i * 20)) = 0 Then
' code to populate
' remember that ".Offset(i * 20)" will return the found 20-rows-2-columns range with no data
Exit For
End If
Next i
End With
End Sub
Related
I have a Button I want to assign a macro to that, when clicked, enters in the number 1 into a specific cell on another sheet within the same workbook. This macro needs to a) match the value in cell B8 to a range of values in another sheet column (G11:G110) and also b) match the value in cell C4 to a range of values in another sheet rows (L4:FR4).
So if the value in B8 = 01234 it will do a vlookup type function on G11:G110. Once it finds its match, it then looks at the value in C4 = "Application" and finds it match in L4:FR4. I should note that there are no duplicate values in any field and the values in L4:FR4 are static, whereas the values in cells G11:G110 change upon refresh.
I have tried Select Case, If...And...Then... and the only thing I got to work was simply saying
If B8 = G11 Then blah blah L11
If B8 = G12 Then blah blah L12
Sub RectangleRoundedCorners1_Click()
Dim sourceSht As Worksheet: Set sourceSht = DataEntry
Dim destSht As Worksheet: Set destSht = Labels
Dim Selection As Range: Set Selection = DataEntry.Range("C5")' This is the # 1 I was talking about'
Dim Acct As Range: Set Acct = DataEntry.Range("B8")
Dim SpecErr As Range: Set SpecErr = DataEntry.Range("C4")
If (SpecErr.Value = Labels.Range("L4")) And (Acct.Value = Labels.Range("G11")) Then
Selection.Copy Destination:=Labels.Range("L11")
End If
If (SpecErr.Value = Labels.Range("M4")) And (Acct.Value = Labels.Range("G11")) Then
Selection.Copy Destination:=Labels.Range("M11")
End If
End Sub
I ran out of space in the code doing it like this, as I need to go from L4 to FR4, and then do this 100 times by adjusting G11 to G12 & L11 to L12 etc.
The sheet holding the main data and Button I called DataEntry, and the sheet that I need to lookup on and have the 1 entered on is called Labels.
I think this is what you need - you can just loop through all the columns (in your case, 12 to 175 represent L to FR), and then loop through rows 11 to 110. Once you get a match, the destination cell is the corresponding column and row to i and j:
Sub RectangleRoundedCorners1_Click()
Dim sourceSht As Worksheet: Set sourceSht = DataEntry
Dim destSht As Worksheet: Set destSht = Labels
Dim Selection As Range: Set Selection = DataEntry.Range("C5") ' This is the # 1 I was talking about'
Dim Acct As Range: Set Acct = DataEntry.Range("B8")
Dim SpecErr As Range: Set SpecErr = DataEntry.Range("C4")
Dim i As Long, j As Long
For i = 12 To 175 'L to FR
For j = 11 To 110
If SpecErr.Value = Labels.Cells(4, i) And Acct.Value = Labels.Cells(j, 7) Then
Selection.Copy Destination:=Labels.Cells(i, j)
End If
Next j
Next i
End Sub
Does this have to be VBA? You could do this with a formula. In sheet 'Labels' cell L11, use this formula and copy over and down:
=IF(AND(DataEntry!$B$8=$G11,DataEntry!$B$4=L$4),1,"")
If it must be VBA, then this can be done basically as a one-liner:
Sub RectangleRoundedCorners1_Click()
On Error Resume Next 'Ignore errors if any fields are not filled out
Sheets("Labels").Cells(Evaluate("MATCH(DataEntry!$B$8,Labels!$G:$G,0)"), Evaluate("MATCH(DataEntry!$B$4,Labels!$4:$4,0)")).Value = Sheets("DataEntry").Range("B5").Value
On Error GoTo 0 'Clear "On Error Resume Next" condition
End Sub
Suppose that I have Excel file consists of four worksheets, lets name them as 1, 2, 3 and 4. I want to evaluate a sum of all values from the cells AK10, AK25, AK40 and so on till AK160 on the worksheet 4 and then place it in the cell G23 of worksheet 2.
Here is my macro that I assign to worksheet 2:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = WorksheetFunction.Sum(s, Worksheets("4").Range("AK(10 + 15 * i)"))
Next i
Range("G23").Value = "s"
End Sub
It ends up with 400 error. What am I doing wrong?
Sub sum_up()
Dim i As Long, s As Long
s = 0
For i = 0 To 10
s = s + Worksheets("4").Cells(10 + 15 * i, "AK").Value
Next i
Range("G23").Value = s
End Sub
I'll take a crack at this - I'd really use a lot more named ranged to pass data back and forth...:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = s + Worksheets("4").Range("AK" & (10 + 15 * i))
Next I
Range("G23").Value = s
End Sub
you did not say that the summation was to be done using VBA
put this in G23 on worksheet2 (actually, put this in any cell)
=SUM('4'!AK10,'4'!AK25,'4'!AK40,'4'!AK55,'4'!AK70,'4'!AK85,'4'!AK100,'4'!AK115,'4'!AK130,'4'!AK145,'4'!AK160)
as far as what you are doing wrong with your code, that has partly been answered by #KenWhite
you are also putting the letter "s" into G23 of any worksheet that happens to be visible at the time your code runs
put in a reference to sheet 2, same as you referenced sheet 4 just two lines above
this code should work:
Sub sum_up()
Dim ws4 As Worksheet
Set ws4 = ActiveWorkbook.Sheets("4")
Dim rng As Range
Set rng = ws4.Range("ak10") ' point to "ak10"
Dim total As Long
total = rng.Value
Do While True
rng.Select
Set rng = rng.Offset(15) ' move pointer down 15 rows
If rng.Row > 160 Then Exit Do ' moved past row 160 ?
total = total + rng.Value
Loop
ActiveWorkbook.Sheets("2").Range("G23").Value = total
End Sub
Following my previous question:
Background Color based on difference with cell
. I would now like to apply this function to a range of rows.
The function I'd like to apply is:
If Sheets("X").Range("E18") > Sheets("blocked(R)").Range("D18") Then
Sheets("X").Range("E18").Interior.ColorIndex = 10
The range I need to apply this function to is fixed: D18:E1200.
However, there will be an active filter on this range.
The Autofill code of course is not working and writing a line of code for each of 1200 rows would be crazy.
I have been searching and reading and I think it must be something like:
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("A1:C2")
For Each row In rng.Rows
For Each cell in row.Cells
'Do Something
Next cell
Next row
But I don't seem to get it to work, I was hoping for some pointing into the right direction of the community.
Sub test()
Dim rngApply As Range
Set rngApply = Sheets("X").Range("D18:E1200")
Dim varIndex As Variant
For Each varIndex In rngApply
If varIndex.Value > Sheets("blocked(R)").Range("D18") Then
varIndex.Interior.ColorIndex = 10
End If
Next
End Sub
So I have data with around 20,000 records. I want to set the range such that only data from Row 2 to 20,000 is checked in column A. However, cell 20,001 isn't blank, it could contain spaces as well.
(This data is imported prior to validation, so I cannot alter it)
When I use .End(xlUp) it ends up checking till some 50,000th row.
Any Help?
Sample:
Column A
A
B
(2 spaces inserted)
I want to check for cells only till B(including it)
Update:
Managed to return the last required cell to the main sub
Private Sub last()
Dim rngX As Range
Set rngX = ActiveSheet.Range("A1").EntireColumn.Find(" ", lookat:=xlPart)
If Not rngX Is Nothing Then
/* return value
End If
End Sub
GD pnuts,
If you want to use VBA, you could contemplate checking for [space] character ? assuming the cell contains only spaces (or only one for that matter)
Something like:
Dim r as range
set r = range("B")
For each c in r.rows
if instr(1, c.value,chr(32)) > 0 then
'do something
end if
next
You could function a check of all characters in cell.value string to validate that they are only spaces ?
Does that help ?
I believe you will have to test each cell individually. To make the number of cells to check smaller, and to speed things up, I would first read the column to check into a Variant array, and then check that from bottom to top. I the spaces are truly a space, the test below will work. If the space is a NBSP, or a combination, then you will have to revise the check to ensure that is the only thing present.
e.g: to check column A:
Option Explicit
Sub foo()
Dim R As Range
Dim WS As Worksheet
Dim V As Variant
Dim I As Long
Set WS = Worksheets("sheet2")
With WS
V = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For I = UBound(V) To LBound(V) Step -1
'Revise this check line as needed
If Len(Trim(V(I, 1))) > 0 Then Exit For
Next I
Set R = .Cells(I, 1)
End With
Debug.Print R.Address
End Sub
You might want to add some error checking in case all of the cells are empty.
So I need to extract information from a sheet with only certain values. From about 550 rows down to 50 which are spread across the entire sheet.
So I used autofilter for that. Now I only see the rows which match to my criteria but how can I get the values of a specific range from?
This far I came:
I know that I have to use
RangeINamed.SpecialCells(xlCellTypeVisible)
to work with only the visible information.
It worked for getting the starting and last row
startRow = bulkbatchRange.SpecialCells(xlCellTypeVisible).row
endRow = startRow + bulkbatchRange.SpecialCells(xlCellTypeVisible).rows.Count
But now I need to get the value of a specific column, I want to use a For loop so I can loop through all visible rows.
So I tried to do
RangeINamed.SpecialCells(xlCellTypeVisible).range("U" & rowNumber).value
That didn't work it gave me nothing. Now I'm rather clueless so does someone maybe know how I get the value of that row in column U in RangeINamed?
Thank you
You can always retrieve the value in a specific cell like U10 with:
Range("U10").Value
whether the row is hidden or not.
EDIT#1:
Here is a little example that loops down thru column A of an AutoFiltered table. It looks for the third visible row (not including the header row):
Sub GoDownFilter()
Dim rLook As Range, r As Range
Set rLook = Intersect(ActiveSheet.UsedRange, Range("A:A").Cells.SpecialCells(xlCellTypeVisible))
rLook.Select
K = 0
For Each r In rLook
If K = 3 Then
r.Select
MsgBox "The third visible row has been selected"
Exit Sub
End If
K = K + 1
Next r
End Sub
I think you need to choose if you want to get a specific cell like:
Range("U10").Value
Or a relative cell using something like
RangeINamed.SpecialCells(xlCellTypeVisible)(2,3).Value
Or
RangeINamed.SpecialCells(xlCellTypeVisible)(2,3).Address 'To see if you are getting it right
EDIT:
A complete code to Filter and Iterate.
Sub Filter()
Dim tableRange As Range, var, actualRow As Integer, lastRow As Integer
Set tableRange = Range("PUT_THE_TABLE_RANGE_HERE")
' Filter
With tableRange
Call .AutoFilter(5, "SPECIFIC_FILTER")
End With
Set f = tableRange.SpecialCells(xlCellTypeVisible)
With tableRange
Call .AutoFilter(5)
End With
For Each var In f.Cells.Rows
actualRow = var.Row
If actualRow <> 1 Then
' Do something
End If
Next
End Sub