tempwb.Sheets(1).Range("B2:B" & temprowcount).SpecialCells(xlCellTypeVisible).Rows.Count
To update on new Automation Techniques using Excel,Ms Access, SQL Server, Power BI and ASP.Net
Showing posts with label Autofilter in VBA. Show all posts
Showing posts with label Autofilter in VBA. Show all posts
Sunday, November 13, 2016
Vba Code to Count Visible Rows After Autofiltering a Excel Sheet
tempwb.Sheets(1).Range("B2:B" & temprowcount).SpecialCells(xlCellTypeVisible).Rows.Count
Thursday, September 3, 2015
Autofilter Automation inbetween two Dates
Dim myArray(3) As String, lookuprng As Range
Public rowcount As Long, wb As Workbook
Public sheetname As String, newrowcount As Long, datarng As Range, tempval As Integer
Private Sub CommandButton1_Click()
''On Error Resume Next
tempval = 0
For j = 0 To 3
sheetname = Format(CDate(TextBox1.Value), "mmm") & "'" & Format(CDate(TextBox1.Value), "yy")
rowcount = ThisWorkbook.Sheets(sheetname).Range("B" & Rows.Count).End(xlUp).Row
Set lookuprng = ThisWorkbook.Sheets(sheetname).Range("A:A").Find(myArray(j), LookIn:=xlValues)
If lookuprng Is Nothing Then
ThisWorkbook.Sheets(sheetname).Range("A" & rowcount + 3) = myArray(j)
ThisWorkbook.Sheets(sheetname).Range("B" & rowcount + 3) = TextBox1.Value & "-" & TextBox2.Value
ThisWorkbook.Sheets(sheetname).Range("A" & (rowcount + 3) & ":B" & (rowcount + 3)).Font.Bold = True
Exit For
End If
Next
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Onsite Report.xlsx")
newrowcount = wb.Sheets(sheetname).Range("B" & Rows.Count).End(xlUp).Row
i = 0
wb.Sheets(sheetname).AutoFilterMode = False
wb.Sheets(sheetname).Range("A1:T1").AutoFilter field:=3, Criteria1:=">=" & TextBox1.Value, Operator:=xlAnd, Criteria2:="<=" & TextBox2.Value
Set datarng = wb.Sheets(sheetname).Range("B4:B" & newrowcount).SpecialCells(xlCellTypeVisible)
For Each cell In datarng
i = i + 1
ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 5 + i)) = cell
ThisWorkbook.Sheets(sheetname).Range("C" & (rowcount + 5 + i)) = cell.Offset(0, 7)
ThisWorkbook.Sheets(sheetname).Range("D" & (rowcount + 5 + i)) = cell.Offset(0, 10)
ThisWorkbook.Sheets(sheetname).Range("E" & (rowcount + 5 + i)) = cell.Offset(0, 15)
ThisWorkbook.Sheets(sheetname).Range("F" & (rowcount + 5 + i)) = cell.Offset(0, 6)
ThisWorkbook.Sheets(sheetname).Range("G" & (rowcount + 5 + i)) = cell.Offset(0, 4)
tempval = tempval + CInt(ThisWorkbook.Sheets(sheetname).Range("G" & (rowcount + 5 + i)))
Next
ThisWorkbook.Sheets(sheetname).Range("G" & (rowcount + 6 + i)) = tempval
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Application.DisplayAlerts = False
wb.Close
Unload Me
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
'Application.ScreenUpdating = False
TextBox1.Value = Format(Date, "d-mmm-yy")
TextBox2.Value = Format(Date, "d-mmm-yy")
myArray(0) = "Week 1"
myArray(1) = "Week 2"
myArray(2) = "Week 3"
myArray(3) = "Week 4"
End Sub
Download File
Public rowcount As Long, wb As Workbook
Public sheetname As String, newrowcount As Long, datarng As Range, tempval As Integer
Private Sub CommandButton1_Click()
''On Error Resume Next
tempval = 0
For j = 0 To 3
sheetname = Format(CDate(TextBox1.Value), "mmm") & "'" & Format(CDate(TextBox1.Value), "yy")
rowcount = ThisWorkbook.Sheets(sheetname).Range("B" & Rows.Count).End(xlUp).Row
Set lookuprng = ThisWorkbook.Sheets(sheetname).Range("A:A").Find(myArray(j), LookIn:=xlValues)
If lookuprng Is Nothing Then
ThisWorkbook.Sheets(sheetname).Range("A" & rowcount + 3) = myArray(j)
ThisWorkbook.Sheets(sheetname).Range("B" & rowcount + 3) = TextBox1.Value & "-" & TextBox2.Value
ThisWorkbook.Sheets(sheetname).Range("A" & (rowcount + 3) & ":B" & (rowcount + 3)).Font.Bold = True
Exit For
End If
Next
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Onsite Report.xlsx")
newrowcount = wb.Sheets(sheetname).Range("B" & Rows.Count).End(xlUp).Row
i = 0
wb.Sheets(sheetname).AutoFilterMode = False
wb.Sheets(sheetname).Range("A1:T1").AutoFilter field:=3, Criteria1:=">=" & TextBox1.Value, Operator:=xlAnd, Criteria2:="<=" & TextBox2.Value
Set datarng = wb.Sheets(sheetname).Range("B4:B" & newrowcount).SpecialCells(xlCellTypeVisible)
For Each cell In datarng
i = i + 1
ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 5 + i)) = cell
ThisWorkbook.Sheets(sheetname).Range("C" & (rowcount + 5 + i)) = cell.Offset(0, 7)
ThisWorkbook.Sheets(sheetname).Range("D" & (rowcount + 5 + i)) = cell.Offset(0, 10)
ThisWorkbook.Sheets(sheetname).Range("E" & (rowcount + 5 + i)) = cell.Offset(0, 15)
ThisWorkbook.Sheets(sheetname).Range("F" & (rowcount + 5 + i)) = cell.Offset(0, 6)
ThisWorkbook.Sheets(sheetname).Range("G" & (rowcount + 5 + i)) = cell.Offset(0, 4)
tempval = tempval + CInt(ThisWorkbook.Sheets(sheetname).Range("G" & (rowcount + 5 + i)))
Next
ThisWorkbook.Sheets(sheetname).Range("G" & (rowcount + 6 + i)) = tempval
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ThisWorkbook.Sheets(sheetname).Range("B" & (rowcount + 6) & ":G" & (rowcount + 5 + i)).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Application.DisplayAlerts = False
wb.Close
Unload Me
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
'Application.ScreenUpdating = False
TextBox1.Value = Format(Date, "d-mmm-yy")
TextBox2.Value = Format(Date, "d-mmm-yy")
myArray(0) = "Week 1"
myArray(1) = "Week 2"
myArray(2) = "Week 3"
myArray(3) = "Week 4"
End Sub
Download File
Subscribe to:
Posts (Atom)