Thursday, September 17, 2015

Using adOpenStatic in Databse Connectivity(VBA)

Dim conn As New ADODB.Connection
Dim rst As New ADODB.Recordset, rowcount As Long
Dim sqlqyerystr As String, coulumncounter As Long, rowcounter As Long
Sub updaterecord()
'On Error Resume Next
Application.ScreenUpdating = False
rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets(1).Range("A2:S" & rowcount).ClearContents
conn.ConnectionString = "Data Source=TADA;Initial Catalog=Firdb;uid=kshr;pwd=A343jNMS;"
conn.Open
sqlqyerystr = "Select * from tblnewjoineeemployeedetail ;"

rst.Open sqlqyerystr, conn, adOpenStatic
Dim myArray()
myArray = rst.GetRows()
MsgBox "updating File for New Employee.........."
coulumncounter = UBound(myArray, 1)
rowcounter = UBound(myArray, 2)
For j = 0 To rowcounter
    For i = 0 To coulumncounter
   
        ThisWorkbook.Sheets(1).Range("A1").Offset(0, i).Value = rst.Fields(i).Name
        ThisWorkbook.Sheets(1).Range("A1").Offset(j + 1, i).Value = myArray(i, j)
       
    Next
Next
rst.Close
conn.Close
rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets(1).Range("A1:AM1").AutoFilter Field:=39, Criteria1:="<" & Format(Date, "m/d/yyyy")
ThisWorkbook.Sheets(1).Range("AM2:AM" & rowcount).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ThisWorkbook.Sheets(1).AutoFilterMode = False
Set rst = Nothing
Set conn = Nothing
End Sub

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