PDA

View Full Version : select a range using 2 address and find if range is empty/has data



mikemike
11-07-2017, 12:30 PM
Hello,

I am trying to use two dates (start and end dates which I currently have the address and column number for) and find out if within that row range if there is data or not. This would be within a loop that would iterate and check each row. If its empty leave it, if its got data transfer to another sheet.
I have been playing with a series of ideas but no luck. Can you suggest a method on how to do this?

To start, I want to get the range part of code correct but to no avail:
With Worksheets("Sheet1").Range(Cells(3, columnnumberstart), Cells(5, columnnumberend)).Select

Heres one idea I have:
for loop
If IsEmpty(Range(Cells(6, columnnumberstart), Cells(6, columnnumberend))) = True Then
copy range
endif


Thank you
Michael

End If

mdmackillop
11-07-2017, 03:59 PM
Please post a workbook with sample data. Go Advanced /Manage Attachments

mikemike
11-08-2017, 05:47 AM
Thank you for the response. I have attached file as requested. I apologize it was not clear.

Maybe this will be clearer.

-User enters start date and end date in sheet 2 to be used to search between them in sheet1
-programs purpose is to display any vacation days if any for each person between those dates in sheet1
-I am thinking search between these dates using this format:
Range("columnnumberstart" & "i" & ":" & ColumnLettersFromRangeend & "i") using a for loop and the column numbers for start and end date. I cant seem to get this range statement to work in sheet1 from a command button in sheet2.

Any propose approach is appreciated

Mike

mdmackillop
11-08-2017, 06:08 AM
Can you add to your workbook a sample of your desired result.

mikemike
11-08-2017, 07:11 AM
Can you add to your workbook a sample of your desired result.

I have included a sample of output in sheet"print schedule" for the dates the used entered of jan 5 to 8. It will search sheet"vacation schedule" for any v or f entries and pass them to print schedule.

Hope this helps
thanks
Mike

mdmackillop
11-08-2017, 07:53 AM
I'll leave you to add code to clear old data.

Sub Test()

Set wsS = Sheets("Vacation Schedule")
Set wsT = Sheets("Print Schedule")
LRw = wsS.Cells(Rows.Count, 1).End(xlUp).Row
Rws = LRw - 2
With wsS
Range(.Cells(4, 1), .Cells(LRw, 4)).Copy wsT.Range("A8")
Set Strt = .Rows(3).Find(wsT.Range("D1"))
Set Endd = .Rows(3).Find(wsT.Range("D2"))
cols = Endd.Column - Strt.Column + 1
For Each col In Range(Strt, Endd).Resize(Rws).Columns
If Application.CountA(col) > 1 Then
i = i + 1
col.Copy wsT.Range("F7").Offset(, i)
End If
Next col
End With


wsT.Range("E8").Resize(Rws - 1).FormulaR1C1 = "=COUNTIF(RC[2]:RC[" & cols + 1 & "],""f"")"
wsT.Range("F8").Resize(Rws - 1).FormulaR1C1 = "=COUNTIF(RC[1]:RC[" & cols & "],""v"")"
End Sub

p45cal
11-08-2017, 03:44 PM
here's another one to play with (see comments in code):
Private Sub CommandButton1_Click()
Dim rgFoundend As Range, rgFoundstart As Range, myDataBodyrng As Range, myrngNonEmpty As Range, myrng As Range, rngToCopy As Range
Dim lastrowsheet1_final As Long, LastColumnNo As Long
Dim datestart, dateend
If Cells(1, 4) > Cells(2, 4) Then
MsgBox ("'End Date' must be greater than 'Start Date' Please change")
Exit Sub
End If
datestart = Cells(1, 4)
dateend = Cells(2, 4)

With Worksheets("Vacation Schedule")
'FIND LAST ROW IN SHEET1 FOR COLUMN A, C and D
lastrowsheet1_final = WorksheetFunction.Max(.Cells(.Rows.Count, "a").End(xlUp).Row, .Cells(.Rows.Count, "c").End(xlUp).Row, .Cells(.Rows.Count, "d").End(xlUp).Row) ' find max number of set of last row variables
Set rgFoundstart = .Range("g3:nn3").Find(datestart) 'find cell with start date entered by user
Set rgFoundend = .Range("g3:nn3").Find(dateend) 'find cell with start date entered by user
If rgFoundstart Is Nothing Then 'if not found then message and abort:
MsgBox "Start Date not found"
Exit Sub
End If
If rgFoundend Is Nothing Then 'if not found then message and abort:
MsgBox "End Date not found"
Exit Sub
End If

Set myrng = .Range(rgFoundstart, rgFoundend)
Set myDataBodyrng = myrng.Offset(1).Resize(lastrowsheet1_final - 3)
On Error Resume Next
Set myrngNonEmpty = myDataBodyrng.SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If myrngNonEmpty Is Nothing Then 'if no data between the dates then message and abort:
MsgBox "No data within the dates provided." & vbLf & "Aborting…"
Exit Sub
End If
LastColumnNo = Intersect(.Rows(1), myrngNonEmpty.EntireColumn).Cells.Count + 6 'will be used in the formulae later.
Set rngToCopy = Union(.Range("A3:F" & lastrowsheet1_final), Intersect(myrngNonEmpty.EntireColumn, Union(myDataBodyrng, myrng)))
Intersect(Me.UsedRange, Me.UsedRange.Offset(5)).ClearContents ' Clear destination area before psting new data.
rngToCopy.Copy Range("A6")
'Add formulae in columns E and F (you can remove these next two lines if you want to keep the values in these columns as they are on the source sheet):
Range("E7").Resize(myDataBodyrng.Rows.Count).FormulaR1C1 = "=IF(COUNTIF(RC7:RC" & LastColumnNo & ",""f"")=0,"""",COUNTIF(RC7:RC" & LastColumnNo & ",""f""))"
Range("F7").Resize(myDataBodyrng.Rows.Count).FormulaR1C1 = "=IF(COUNTIF(RC7:RC" & LastColumnNo & ",""v"")=0,"""",COUNTIF(RC7:RC" & LastColumnNo & ",""v""))"
End With
Cells(3, 1) = "Last Updated: " & Date 'only update this date when new data has been placed on the sheet.
End Sub