I have a code as below and i want to reset "add" as 1 when a new loop starts for the next row.
Sub Group()
DataBook = ThisWorkbook.Name
Dim i As Long
RowCount = 1
RowCount2 = 1
Add = 1
For i = 19 To 1819
If Workbooks(DataBook).Sheets("Template").Range("G" & i).IndentLevel = 8 Then
Workbooks(DataBook).Sheets("Sheet1").Cells(RowCount, 2) = Workbooks(DataBook).Sheets("Template").Range("G" & i).Value
RowCount = RowCount + 1
If Workbooks(DataBook).Sheets("Template").Range("G" & i - Add).IndentLevel = 7 Then
Workbooks(DataBook).Sheets("Sheet1").Cells(RowCount2, 1) = Workbooks(DataBook).Sheets("Template").Range("G" & i - Add)
RowCount2 = RowCount2 + 1
Add = Add + 1
End If
End If
Next i
End Sub
Switch these two lines:
Add = 1
For i = 19 To 1819
I.e:
For i = 19 To 1819
Add = 1
I have the below code which will transfer the records from my datagrid to my excel spreadsheet.
Currently this code works for one datagrid to an excel sheet. Now I need to improve the below code so that it can work for multiple datagrids. I want help to extend this code so that I can pull the records from 3 data grids to the same excel sheet one below another.
Dim excel As Microsoft.Office.Interop.Excel.Application
Try
excel = New Microsoft.Office.Interop.Excel.Application
excel.Workbooks.Open("C:\Satish\TestExcel\vbexcel.xlsx")
Dim i As Integer, j As Integer
Dim diff As Integer = 1
' if you want column header from dgv elese omit the block
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For j = 0 To DataGridView1.ColumnCount - 1
excel.Worksheets(1).cells(1, j + 1) = DataGridView1.Columns(j).Name
Next
diff += 1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 0 To DataGridView4.RowCount - 1
If DataGridView4.Rows(i).IsNewRow = False Then
For j = 0 To DataGridView4.ColumnCount - 1
excel.Worksheets(1).cells(i + diff, j + 1) = DataGridView4.Item(j, i).Value
Next
End If
Next
excel.Worksheets(1).select()
excel.ActiveWorkbook().Save()
excel.Workbooks.Close()
excel.Quit()
excel = Nothing
Catch ex As System.Runtime.InteropServices.COMException
MessageBox.Show("Error accessing Excel: " + ex.ToString())
Catch ex As Exception
MessageBox.Show("Error: " + ex.ToString())
End Try
Try this code:
Dim intExcelRow As Integer = 1
For i As Integer = 1 To 3
Dim YourDataGridView As DataGridView = Me.Controls("YourDataGridView" & i)
'header of the first DataGridView only
'remove If i = 1 if you need to print 3 different headers
If i = 1 Then
For intColumn = 0 To YourDataGridView.ColumnCount - 1
excel.Worksheets(1).cells(intExcelRow, intColumn + 1) = YourDataGridView.Columns(intColumn).Name
Next intColumn
intExcelRow = intExcelRow + 1
End If
For intRow = 0 To YourDataGridView.RowCount - 1
If YourDataGridView.Rows(intRow).IsNewRow = False Then
For intColumn = 0 To YourDataGridView.ColumnCount - 1
excel.Worksheets(1).cells(intExcelRow, intColumn + 1) = YourDataGridView.Item(intColumn, intRow).Value
Next intColumn
intExcelRow = intExcelRow + 1
End If
Next intRow
Next i
Sub Add_sumf()
Dim i As Integer
i = 3
Dim cellDate As Integer
cellDate = 0
Dim cellDate1 As Date
cellDate1 = TimeValue("00:00:00")
Dim total As Integer
total = 0
Dim j As Integer
j = 2
Dim k As Integer
k = 2
Set aa = Workbooks("Book3").Worksheets(1)
Set bb = Workbooks("Final_result").Worksheets(1)
Do While bb.Cells(1, k).Value <> ""
For Each y In bb.Range("A:A")
On Error GoTo Label
If UCase(bb.Cells(j, "A").Value) <> "" Then
cellDate1 = WorksheetFunction.SumIfs(aa.Range("F:F"), aa.Range("B:B"), UCase(bb.Cells(1, k).Value), aa.Range("G:G"), UCase(bb.Cells(j, "A").Value))
bb.Cells(j, k).Value = TimeValue(cellDate1)
cellDate1 = TimeValue("00:00:00")
bb.Cells(j, k).NumberFormat = "[h]:mm:ss"
On Error GoTo Label
j = j + 1
Else
Exit For
End If
Next
j = 2
k = k + 1
Loop
Label:
'MsgBox Err.Description
Exit Sub
End Sub
I am using above code to add time duration based upon value of two other columns but I always get 00:00:00 as result.
if i use below code i get the answer but its too slow very slow
Sub add_it_time()
Dim i As Integer
i = 3
Dim cellDate As Integer
cellDate = 0
Dim cellDate1 As Date
cellDate1 = TimeValue("00:00:00")
Dim total As Integer
total = 0
Dim j As Integer
j = 2
Dim k As Integer
k = 2
Set aa = Workbooks("Book3").Worksheets(1)
Set bb = Workbooks("Final_result").Worksheets(1)
Do While bb.Cells(1, k).Value <> ""
'MsgBox bb.Cells(1, k).Value
For Each y In bb.Range("A:A")
On Error GoTo Label
' MsgBox UCase(bb.Cells(j, "A").Value)
If UCase(bb.Cells(j, "A").Value) <> "" Then
For Each x In aa.Range("F:F")
On Error Resume Next
If UCase(aa.Cells(i, "B").Value) = UCase(bb.Cells(j, "A").Value) Then
' MsgBox aa.Cells(i, "F").Text
' total = total + Int(get_Second(aa.Cells(i, "F").Text))
If UCase(aa.Cells(i, "G").Value) = UCase(bb.Cells(1, k).Value) Then
'MsgBox aa.Cells(i, "F").Text
cellDate1 = cellDate1 + TimeValue(aa.Cells(i, "F").Value)
End If
End If
i = i + 1
Next
i = 3
On Error GoTo Label
bb.Cells(j, k).NumberFormat = "h:mm:ss"
bb.Cells(j, k).Value = WorksheetFunction.Text(cellDate1, "[hh]:mm:ss")
total = 0
cellDate1 = 0
j = j + 1
Else
Exit For
End If
Next
j = 2
k = k + 1
Loop
Label:
'MsgBox Err.Description
Exit Sub
End Sub
The source column which contains date is of general formatt
I am new to VBA macros
UPDATED SOLUTION:
After discussion in chat with OP it was decided that pure formula solution is fine - below are formulas / actions to do on the separate sheet starting A1:
Row A will be resulting table header: in A1 I added Agent Name / Release Code, and starting B1 there's a list of all available Release Code values (easily got using Remove Duplicates).
I defined the following named ranges for the simplicity and effectiveness (since initial data is NOT static): AgentNames=OFFSET('Agent State'!$B$2,0,0,COUNTA('Agent State'!$B:$B)-1,1) - this will return the range of names on the initial sheet excluding the header; TimeInStateData=OFFSET(AgentNames,0,4) and ReleaseCodes=OFFSET(AgentNames,0,5) as shifted AgentNames range.
In column A we should obtain the list of names, which should be unique, so select in column A any number of cells which is NOT less that number of unique names - for the sample I used A2:A51, and type that formula: =IFERROR(INDEX(AgentNames,SMALL(IF(MATCH(AgentNames,AgentNames,0)=ROW(INDIRECT("1:"&ROWS(AgentNames))),MATCH(AgentNames,AgentNames,0),""),ROW(INDIRECT("1:"&ROWS(AgentNames))))),"") and press CTRL+SHIFT+ENTER instead of usual ENTER - this will define a Multicell ARRAY formula and will result in curly {} brackets around it (but do NOT type them manually!).
B2: =IF(OR($A2="",SUMPRODUCT(--($A2=AgentNames),--(B$1=ReleaseCodes),TIMEVALUE(TimeInStateData))=0),"",SUMPRODUCT(--($A2=AgentNames),--(B$1=ReleaseCodes),TIMEVALUE(TimeInStateData))) - normal formula, which will return empty value for either empty name or zero time.
Copy formula from B2 to the whole table.
Remarks:
Resulting range for the sum of time values should be formatted as Time.
If the list of names should be expanded in the future - repeat step 3 for the new range, but do NOT drag the formula down - this will result in You cannot change part of an array error.
Sample file: https://www.dropbox.com/s/quudyx1v2fup6sh/AgentsTimeSUM.xls
INITIAL ANSWER:
Perhaps that's too simple and obvious, but at a glance I don't understand why you have that line of code:
cellDate1 = TimeValue("00:00:00")
right after your SUMIFS: cellDate1 = WorksheetFunction.SumIfs(aa.Range("F:F"), ...
Try to remove the first one where you assign zeros to cellDate1.
I am getting the 1004 error when running. The error is at this line:
If IsNumeric(wkbCurr.Sheets(CTRYname).Range(column & x).Value) = True Then
What I want to do is to select the sheet (CTRYNAME) and then search through columns 5,7,9 etc and format the numbers as done in the code.
Public Sub MoM_Check()
Dim inti As Integer
Dim intj As Integer
Dim k As Integer
Dim mnth As Integer
Dim currSALE As Double
Dim prevSALE As Double
Dim diffpercent As Double
Dim CTRYname As String
Dim x As Integer
Dim column As String
'Find Difference percentage between sales of 24 common months in present month's extarct and previous month's extract
For n = 1 To 13
Application.SheetsInNewWorkbook = 4
Set wkbTemp = Workbooks.Add
CTRYname = ThisWorkbook.Sheets("Country lookup").Range("A1").Offset(n, 0).Value
'Open a temporary workbook to do all the Calculations
'First the current month's extract is copied to the first sheet
'We now copy sheets for range from wkbout to wkbtemp using usedrange
wkbCurr.Sheets(CTRYname).Activate
wkbCurr.Sheets(CTRYname).UsedRange.Copy
wkbTemp.Sheets("Sheet1").Range("A1").PasteSpecial
wkbprev.Sheets(CTRYname).Activate
wkbprev.Sheets(CTRYname).UsedRange.Copy
wkbTemp.Sheets("Sheet2").Range("A1").PasteSpecial
'open the Previous month's Main Extract file as given in the lookup tab. This data is pasted on sheet2 of temporary workbook.
'This sheet helps us to compare the country channels in current month's extract with the previous Month's Extract.
'So the same process is followed for this sheet and similarly we get the country channels from the previous month's extract and paste them on 'sheet3
'Prevcnt contains the number of country channels in the previous month's extract
k = 1
For mnth = 0 To 22
currSALE = wkbTemp.Sheets("Sheet1").Range("AB10").Offset(0, mnth).Value
prevSALE = wkbTemp.Sheets("Sheet2").Range("AC10").Offset(0, mnth).Value
If prevSALE = 0 And currSALE <> 0 Then
diffpercent = 1
ElseIf prevSALE = 0 And currSALE = 0 Then
diffpercent = 0
Else: diffpercent = (currSALE - prevSALE) / prevSALE
End If
If diffpercent > 0.01 Or diffpercent < -0.01 Then
Set wkbRaw = Workbooks.Open(strOutputQCPath & "Errorlog.xlsx")
wkbRaw.Sheets("Sheet1").Activate
wkbRaw.Sheets("Sheet1").Range("A1").Offset(i, 1 + n).Value = CTRYname & " Incorrect"
Exit For
Else
Set wkbRaw = Workbooks.Open(strOutputQCPath & "Errorlog.xlsx")
wkbRaw.Sheets("Sheet1").Activate
wkbRaw.Sheets("Sheet1").Range("A1").Offset(i, 1 + n).Value = CTRYname & " Correct"
k = k + 1
wkbRaw.SaveAs Filename:=strOutputQCPath & "Errorlog.xlsx"
wkbRaw.Close
End If
Next mnth
For x = 1 To 15
If x = 1 Or x = 2 Or x = 3 Or x = 4 Or x = 6 Or x = 9 Or x = 10 Or x = 11 Or x = 13 Then
GoTo Name
Else
If IsNumeric(wkbCurr.Sheets(CTRYname).Range(column & x).Value) = True Then
If wkbCurr.Sheets(CTRYname).Range(column & x).Value > 9.99 Then
wkbCurr.Sheets(CTRYname).Range(column & x).Value = ">999%"
ElseIf wkbCurr.Sheets(CTRYname).Range(column & x).Value < -9.99 Then
wkbCurr.Sheets(CTRYname).Range(column & x).Value = "<-999%"
End If
End If
End If
Name:
Next x
wkbTemp.Close savechanges:=False
Set wkbTemp = Nothing
Next n
End Sub
Please help!
You haven't given the string "column" a value, which is why you're getting error 1004 on that line.
I am exporting data to excel and try to save to a folder which is in my application...but the excel is saving defaultly in C:\Documents but i wanted to save in E:\Apllication\Reports
Here is my code to generate excel sheet
If ComDset.Tables(0).Rows.Count > 0 Then
Try
With Excel
.SheetsInNewWorkbook = 1
.Workbooks.Add()
.Worksheets(1).Select()
Dim i As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
.cells(1, i).value = ComDset.Tables(0).Columns(col).ColumnName
.cells(1, i).EntireRow.Font.Bold = True
i += 1
Next
i = 2
Dim k As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
i = 2
For row = 0 To ComDset.Tables(0).Rows.Count - 1
.Cells(i, k).Value = ComDset.Tables(0).Rows(row).ItemArray(col)
i += 1
Next
k += 1
Next
filename = "ShiftReport" & Format(MdbDate, "dd-MM-yyyy") & ".xls"
.ActiveCell.Worksheet.SaveAs(filename)
End With
System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
Excel = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
' The excel is created and opened for insert value. We most close this excel using this system
Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
For Each i As Process In pro
i.Kill()
Next
End If
and tell me how to assign colour to the header
Thanks in advance
Have you tried this?
.ActiveCell.Worksheet.SaveAs("E:\Apllication\Reports\" & filename)