I’m trying to copy the current row from the DataGridView into Excel but can’t seem to find the correct syntax for it to work. Hopefully someone can help me out with the below code.
Thanks in advance.
Public Sub CopyRowToExcel()
Dim xlApp As Excel.Application
Dim WB As Excel.Workbook
Dim WS As Excel.Worksheet
Dim LR As Integer
Dim RowNum As Integer
xlApp = GetObject(, Constants.ExcelApp)
WB = xlApp.Workbooks("Products")
WS = WB.Sheets("DataSheet")
LR = WS.Range("A" & WS.Rows.Count).End(Excel.XlDirection.xlUp).Row + 1
RowNum = DataGridView1.CurrentRow.Index
WS.Range("A" & LR & ":L" & LR).Value = DataGridView1.Rows(RowNum).Cells(1 To 12).Value
End Sub
You do not say if the grid has a data source. If you do not have a data source for the grid, then I suggest you use one. It will make things easier in numerous ways, and this is an example.
Assuming the grid has a DataTable as a DataSource, then you should be able to write a whole row to the Excel file similar to what you appear to be asking with…
DataGridView1.Rows(RowNum).Cells(1 To 12).Value
When you set a ranges value in Excel like…
WS.Range("A" & LR & ":L" & LR).Value =
… will work as long as the right-hand side of the “=” is an array of the same dimensions. In this case where the range is a “single” row, then the array needs to be a ONE (1) dimensional array. Then, if the range is larger than the array, it will fill the missing array part(s) with something like… “#N/A” … And if the range is less than the size of the array, then it will ignore the extra values in the array.
If the range dimension is not the same as the array dimension… you will get an error.
Therefore if the grid used a DataTable and you wanted to append the selected row to the end of an existing worksheet, then you should be able to do something like…
Dim excelRange As String = "A" & LR & ":L" & LR
Dim drv As DataRowView = DataGridView1.SelectedRows(0).DataBoundItem
xlWorksheet.Range(excelRange, Type.Missing).Value2 = drv.Row.ItemArray.ToArray()
In my small tests, this worked as described above.
Related
I found a sub that removes the time portion of a date/time stamp from a range that works but it takes a lot of time when that range gets large.
This code works but is slow:
Dim LR As Long
Dim i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To LR
With shRawData.Range("B" & i)
.NumberFormat = "dd/mm/yy"
.Value = DateValue(.Value)
End With
Next i
End Sub
So I tried to put the range into an array and remove tie time portion there but I keep getting a run-time error 424: Object required error. I clearly am not understanding something kind of basic.
Here is the code that fails
Dim i As Long
Dim LastRow As Long
Dim Temp As Date
LastRow = Range("A" & Rows.Count).End(xlUp).Row ' Last row of source worksheet
Dim DateTime As Variant
DateTime = Application.Transpose(shRawData.Range("B2:B" & LastRow))
For i = LBound(DateTime) To UBound(DateTime)
DateTime(i).Value = DateValue(DateTime(i).Value)
Next i
' Write data to Sheet
shRawData.Range("B2:B" & LastRow).Value = Application.Transpose(DateTime)
End Sub
If you know what I'm doing wrong can you please explain what I'm doing wrong.
Thanx
Your code about you appreciate as being slow, does not eliminate any time. It only changes the Date format. If you need to make some calculations, the original time (double) will be taken in consideration. If this does not bother you it si enough to use
shRawData.Range("B2:B" & LR).NumberFormat = "dd/mm/yy"
without any iteration. If you really need to eliminate the time of each cell, you should use:
Sub ElimTime()
Dim shRawData As Worksheet, LR As Long, rngB As Range, arr, i As Long
Set shRawData = ActiveSheet 'use here your necessary sheet if shRawData is not the sheet codeName
LR = shRawData.Range("B" & rows.count).End(xlUp).row
Set rngB = shRawData.Range("B2:B" & LR) 'set the range to be processed
arr = rngB.Value2 'place the range in an array for faster iteration
rngB.NumberFormat = "dd/mm/yy" 'format the Date range as needed
'eliminate the decimal part to let only the `Date` remaining
For i = 1 To UBound(arr)
arr(i, 1) = Fix(arr(i, 1))
Next i
rngB.Value2 = arr 'Drop the array content at once
End Sub
Excel keeps Date as numeric. Date without time is kept as Long and Date with time inclusive as Double. So, you need to eliminate the decimal part...
I'm trying to copy certain columns from a sheet to another (around 15).
My current method is less than ideal (I think).
Sheets(2).Range("A:A").Value = Sheets(1).Range("C:C").Value
Sheets(2).Range("C:C").Value = Sheets(1).Range("G:G").Value
Sheets(2).Range("D:D").Value = Sheets(1).Range("T:T").Value
It looks repetitive and more importantly it copies the entire column, which slows down the process by loading the empty rows until the end of the sheet as well.
I'm trying to figure out the best possible way to copy the columns just up to the last used column.
This is my current idea, but the empty cells in the second sheet are filled with the not available error value, which defeats the purpose.
lastRow = Sheets(1).Range("C" & Sheets(1).Rows.Count).End(xlUp).Row
Sheets(2).Range("A:A").Value = Sheets(1).Range("C1:C" & lastRow).Value
Any function that I'm probably not aware of? Thank you!
(And yes, this must be done in VBA. Ask my boss 😃.)
As your source range is smaller, you have to adjust the size of your target range.
Sub copyData()
Dim arrColumns(1, 2) As String
'mapping source column : target column
arrColumns(0, 0) = "C": arrColumns(1, 0) = "A"
arrColumns(0, 1) = "G": arrColumns(1, 1) = "C"
arrColumns(0, 2) = "I": arrColumns(1, 2) = "D"
With ThisWorkbook
Dim wsSource As Worksheet: Set wsSource = .Worksheets(1)
Dim wsTarget As Worksheet: Set wsTarget = .Worksheets(2)
End With
Dim lastRow As Long
With wsSource
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
End With
'now we can do the copying
Dim i As Long
For i = 0 To UBound(arrColumns, 2)
wsTarget.Columns(arrColumns(1, i)).Resize(lastRow).Value = wsSource.Columns(arrColumns(0, i)).Resize(lastRow).Value
Next
End Sub
Furthermore I like to have mapping arrays at the beginning of such a sub.
In case your boss wants another column to be copied - or copy one to another target column this is much easier to handle.
To make it simple, maybe this can work for you:
Sub test()
Dim i As Long
Dim SourceArray As Variant
Dim DestinyArray As Variant
Dim lastRow As Long
'all ranges must be same size to work so all of them will use same lastRow
SourceArray = Array("A1:A", "C1:C", "D1:D")
DestinyArray = Array("C1:C", "G1:G", "T1:T")
lastRow = Sheets(1).Range("C" & Sheets(1).Rows.Count).End(xlUp).Row
For i = LBound(SourceArray) To UBound(SourceArray) Step 1
Sheets(2).Range(DestinyArray(i) & lastRow).Value = Sheets(1).Range(SourceArray(i) & lastRow).Value
Next i
Erase SourceArray
Erase DestinyArray
End Sub
Easy to update if you need to copy more columns, but remember this code will copy always same quantity of cells so if you are copying ranges of different size, then it won't work.
I am trying to check a PO list against an open PO list and clear the cell from
the PO List if not in the open PO List. I tried multiple variations of code (below) and this one is giving me a Mismatch error. Usually, I do something like i = 0 to 5 but that's when I know the exact length of the list. Doing this without knowing the length has been a challenge. Any help would be very much appreciated.
Sub POCheck()
Dim OpenPO As Worksheet
Set OpenPO = Worksheets("OpenPO")
Dim All As Worksheet
Set All = Worksheets("All")
Dim OpenPOList As Variant
OpenPOList = OpenPO.Range("A2:A" And LastRowPO).Value
Set AllPO = All.Range("B2:B" & LastRow)
Dim i As Long
LastRow = All.Range("AH" & Rows.Count).End(xlUp).Row
LastRowPO = OpenPO.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In AllPO.Cells
For i = LBound(OpenPOList) To UBound(OpenPOList)
Found = False
If Not cell.Find(OpenPOList(i)) Is Nothing Then
Found = True
Exit For
End If
Next i
If Not Found Then cell.Value = ""
Next cell
It is very quick to use arrays and Application.Match to see if current value is in the array containing the values to match against. No looping cells and data is read in and written out in one go.
Option Explicit
Public Sub POCheck()
Dim openPO As Worksheet, all As Worksheet, lastRow As Long, lastRowPO As Long
Set openPO = ThisWorkbook.Worksheets("OpenPO")
Set all = ThisWorkbook.Worksheets("All")
With all
lastRow = .Range("AH" & .Rows.Count).End(xlUp).Row
End With
With openPO
lastRowPO = .Range("A" & Rows.Count).End(xlUp).Row
End With
Dim openPOList(), allPOList(), i As Long
openPOList = Application.Transpose(openPO.Range("A2:A" & lastRowPO))
allPOList = Application.Transpose(all.Range("B2:B" & lastRow))
For i = LBound(allPOList) To UBound(allPOList)
If IsError(Application.Match(allPOList(i), openPOList, 0)) Then
allPOList(i) = vbNullString
End If
Next
openPO.Range("A2").Resize(UBound(allPOList), 1) = Application.Transpose(allPOList)
End Sub
It is considered a best practice to add Option Explicit to the top of the code modules and declare a variables with the correct datatypes.
Dim LastRow As Long, LastRowPO As Long
Use & not And when concatenating strings.
OpenPOList = OpenPO.Range("A2:A" And LastRowPO).Value
LastRowPO is being used before its value is set.
LastRowPO = OpenPO.Range("A" & Rows.Count).End(xlUp).row
OpenPOList = OpenPO.Range("A2:A" & LastRowPO).Value
Use Range.Find to search a group of cells not a single cell.
If Not cell.Find(OpenPOList(i)) Is Nothing Then
Using a Scripting.Dictionary to match unique values is vastly faster then using nested loops. Watch: Excel VBA Introduction Part 39 - Dictionaries.
You should download RubberDuck and use its code formatter often.
You can do a vlookup to see if it exists and then clear the value if vlookup in adjacent cell isn't #N/A?
Or loop down the first list and do a countif in VBA to see if it resides within the other list, if it does, clear it?
So may ways to do it in VBA also...
I'm not very clever with coding and I have a work project to do with Excel (Mac OS Office 365 version). I have some code here from VBA:
Sub Button1_Click()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Case Management").UsedRange.Rows.Count
For r = lastrow To 2 Step -1
If Worksheets("Case Management").Range("AA" & r).Value = "RTW" Or
Worksheets("Case Management").Range("AA" & r).Value = "Out of area" Or
Worksheets("Case Management").Range("AA" & r).Value = "Condition 3"
Then
Worksheets("Case Management").Rows(r).Cut
Destination:=Worksheets("from caseload").Range("A" &
Rows.Count).End(xlUp)(2)
End If
Next r
Application.ScreenUpdating = True
End Sub
So what happens is that it works on any condition set out after I pressed it. But if I filled 3 rows it copies to one specific row as I show in the pictures.
1) I fill out the condition with RTW on first sheet x3 times for show
First Step
2) This is sheet two before button has been pressed
Second Step
3) When I press button on sheet 1 it looks likes this, so far so good
Third Step
4) This should not look like that, there should be 3 rows stacked but that is not the case :(
Fourth Step
BTW the titles are on row 4.
Please help, I looked at similar articles on stack overflow but I cannot figure out the problem. Thanks :)
This should do the trick. The main problem that you had was that you weren't doing anything to duplicate that singe row you were cutting from 'Case Management'. To solve that, I added ws2.rows(lastRow2).copy Destination:=ws2.rows(lastRow2).Resize(3) which resizes the newly pasted row to be copied 2 more times.
I also created some extra variables to clean up the way that the code looks. Notably, I added worksheet variables so that you can specify each worksheet much more simply, and I also added val, which stores the value at ws1.Range("AA" & r). Lastly (and this is personal preference), I like to have the variables dim'ed near the location they are used, so I separated them and declare each variable essentially above where it's used.
Option Explicit
Private Sub Button1_Click()
Application.ScreenUpdating = False
On Error GoTo ErrClose
Dim ws1 As Worksheet
Set ws1 = sheets("Case Management")
Dim ws2 As Worksheet
Set ws2 = sheets("from caseload")
Dim lastRow As Long
lastRow = ws1.UsedRange.rows.count
Dim r As Long
For r = lastRow To 2 Step -1
Dim val As String
val = ws1.Range("AA" & r).Value2
If val = "RTW" Or val = "Out of area" Or val = "Condition 3" Then
Dim lastRow2 As Long
lastRow2 = ws2.Range("A" & rows.count).End(xlUp)
ws1.rows(r).Cut Destination:=ws2.Range("A" & lastRow2)
ws2.rows(lastRow2).copy Destination:=ws2.rows(lastRow2).Resize(3)
End If
Next r
ErrClose:
Application.ScreenUpdating = True
End Sub
If Marcucciboy is correct, change the code this way.
lastRow2 = ws2.Range("A" & rows.count).End(xlUp).Row
Starting from Sheet "DATA" range B4:Hx, where x is my last row taking by a row count. I need to copy this range and paste it as values on sheet "bat" starting at A1.
Going forward I need to offset columns in 6. So my second copy will be I4:Ox and so one copying appending into bat sheet.
I know where I must stop and I'm informing it using the Funds value.
The first error I'm having is when I try set Column2 = Range("H" & bottomD) value that is giving me "overflow".
And sure I don't know yet if my For loop would work.
Sub Copy_bat()
Dim bottomD As Integer
Dim Column1 As Integer
Dim Column2 As Integer
Dim i As Integer
Dim Funds As Integer
Funds = Sheets("bat").Range("u3").Value
Sheets("DATA").Activate
bottomD = Range("A" & Rows.Count).End(xlUp).Row
Column1 = Range("B4")
Column2 = Range("H" & bottomD)
For i = 1 To Funds
Range(Column1 & ":" & Column2).Copy
Sheets("Data").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=False
Column1 = Colum1.Range.Offset(ColumnOffset:=6)
Column2 = Colum2.Range.Offset(ColumnOffset:=6)
Next i
End Sub
Always use Option Explicit at the beginning of every module to prevent from typos. Always! You had typos at the bottom - Colum1 and Colum2.
Avoid Activate and Select (you had Sheets("DATA").Activate) - better performance, smaller error chance. Instead, you should always explicitly tell VBA which sheet you are referring to.
While pasting values you can simply do something like Range2.value = Range1.value. No need to .Copy and then .Paste.
I did my best to understand what you need. From my understanding you did not use Range data type, while you needed that. This caused you errors.
Option Explicit
Sub Copy_bat()
Dim bottomD As Integer
Dim i As Integer
Dim Funds As Integer
Dim rngArea As Range
Funds = Sheets("bat").Range("u3").Value
With Sheets("Data")
bottomD = .Range("A" & .Rows.Count).End(xlUp).Row
Set rngArea = Range(.Range("B4"), .Range("H" & bottomD))
End With
For i = 1 To Funds
Sheets("bat").Cells(Rows.Count, "A").End(xlUp)(2).Resize(rngArea.Rows.Count, rngArea.Columns.Count).Value = _
rngArea.Value
Set rngArea = rngArea.Offset(, 7)
Next
End Sub
I made one rngArea variable of type Range instead of 2 variables (Column1 and Column2). This code takes info from "Data" sheet and puts that to "bat" sheet. Then offsets to right by 7(!) columns in "Data" sheet and puts data in "bat" sheet below the data that was put previously.