I'm trying to export the content of a DataGridView to an excel worksheet by using the below code
Dim xlApp As New Microsoft.Office.Interop.Excel.Application
Dim xlBook As Microsoft.Office.Interop.Excel.Workbook = xlApp.Workbooks.Add
Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet = CType(xlBook.Sheets(1), Microsoft.Office.Interop.Excel.Worksheet)
xlSheet.Name = "MySheet"
xlApp.Visible = True
With xlSheet
For C As Integer = 0 To DGV_IntCalc.Columns.Count - 1
.Range(.Cells(1, C + 1)).Value = DGV_IntCalc.Columns(C).HeaderText
For R As Integer = 0 To DGV_IntCalc.RowCount - 1
.Range(.Cells(R + 2, C + 1)).Value = DGV_IntCalc.Rows(R).Cells(C).Value
Next
Next
End With
I get error on .Range(.Cells(1, C + 1)).Value = DGV_IntCalc.Columns(C).HeaderText
I have Option Strict On so I can't use .Cells(1, C + 1).Value = DGV_IntCalc.Columns(C).HeaderText because of the late binding
Where am I wrong?
Even if the range has only one cell, you need to insert both starting and ending cells of the range.
The solution is to change:
.Range(.Cells(1, C + 1)).Value = DGV_IntCalc.Columns(C).HeaderText
with:
.Range(.Cells(1, C + 1), .Cells(1, C + 1)).Value = DGV_IntCalc.Columns(C).HeaderText
Related
I have a value in column C which in some cases are duplicated, where there are duplicates I want it to look in column Z for the corresponding ID if none exist I want it to check where whether any other values in column C have a value in Column Z and then add the missing values into column Z accordingly:
Column C Column Z
45519 Blank*
45519 1
456 2
456 *Blank
Expected result:
Column C: Column Z
45519 1
45519 1
456 2
456 2
Stackoverflow Code I have adapted to use 1 and 24 respectively.
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("transactions")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim dataArr()
dataArr = ws.Range("C1:Z" & lastRow).Value
Dim currentRow As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 2)
If Not IsEmpty(dataArr(currentRow, 2)) And Not dict.Exists(dataArr
(currentRow, 1)) Then
dict.Add dataArr(currentRow, 1), dataArr(currentRow, 2)
End If
Next currentRow
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)
If IsEmpty(dataArr(currentRow, 2)) Then
dataArr(currentRow, 2) = dict(dataArr(currentRow, 1))
End If
Next currentRow
ws.Range("C1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)) = dataArr
End Sub
I am receiving no result in column Z as a result of this
Try this. Amended column references as per comments, plus I think your first loop was unnecessarily long. You'll need to change the 24s if your array is actually of a different size.
Option Explicit
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Worksheets("transactions")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim dataArr()
dataArr = ws.Range("C1:Z" & lastRow).Value
Dim currentRow As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)
If Not IsEmpty(dataArr(currentRow, 24)) And Not dict.Exists(dataArr(currentRow, 1)) Then
dict.Add dataArr(currentRow, 1), dataArr(currentRow, 24)
End If
Next currentRow
For currentRow = LBound(dataArr, 1) To UBound(dataArr, 1)
If IsEmpty(dataArr(currentRow, 24)) Then
dataArr(currentRow, 24) = dict(dataArr(currentRow, 1))
End If
Next currentRow
ws.Range("C1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)) = dataArr
End Sub
Alternative method
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Worksheets("transactions")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim r As Range, r1 As Range, s As String
For Each r In ws.Range("Z1:Z" & lastRow).SpecialCells(xlCellTypeBlanks)
Set r1 = ws.Range("C1:C" & lastRow).Find(ws.Cells(r.Row, "C"), , , xlWhole)
If Not r1 Is Nothing Then
s = r1.Address
Do Until r1.Row <> r.Row
Set r1 = ws.Range("C1:C" & lastRow).FindNext(r1)
If r1.Address = s Then Exit Do
Loop
r.Value = ws.Cells(r1.Row, "Z")
End If
Next r
End Sub
There is some tidying up to do. Currently assumes data starts in row 2.
Option Explicit
Public Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("transactions")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Dim unionRng As Range
Set unionRng = Union(ws.Range("C2:C" & lastRow), ws.Range("Z2:Z" & lastRow))
Dim dataArray()
Dim numberOfColumns As Long
numberOfColumns = unionRng.Areas.Count
ReDim dataArray(1 To lastRow, 1 To numberOfColumns) '1 could come out into variable startRow
Dim currRow As Range
Dim columnToFill As Long
For columnToFill = 1 To numberOfColumns
For Each currRow In unionRng.Areas(columnToFill)
dataArray(currRow.Row - 1, columnToFill) = currRow 'assume data starts in row 1 otherwise if 2 then currRow.Row -1 etc
Next currRow
Next columnToFill
Dim currentRow As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
If Not IsEmpty(dataArray(currentRow, 2)) And Not dict.Exists(dataArray(currentRow, 1)) Then
dict.Add dataArray(currentRow, 1), dataArray(currentRow, 2)
End If
Next currentRow
For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
If IsEmpty(dataArray(currentRow, 2)) Then
dataArray(currentRow, 2) = dict(dataArray(currentRow, 1))
End If
Next currentRow
ws.Range("Z2").Resize(UBound(dataArray, 1), 1) = Application.Index(dataArray, 0, 2)
End Sub
you could very simply go like follows
Option Explicit
Sub main()
Dim cell As Range, IdsRng As Range
With Worksheets("transactions") 'reference wanted sheet
Set IdsRng = .Range("Z2", .Cells(.Rows.Count, "Z").End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants, xlNumbers) 'get all IDs from its column Z cells with constant numeric value
With .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)) 'reference referenced sheet column C cells from row 1 (header) down to last not empty one
For Each cell In IdsRng 'loop through all IDs
.AutoFilter Field:=1, Criteria1:=cell.Offset(, -23).value ' filter referenced cells on 1st column with passed ID content 'filter referenced range with current ID
.Offset(1, 23).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).value = IdsRng.value 'write all filtered cells corresponding values in column Z with current ID
Next
End With
.AutoFilterMode = False
End With
End Sub
my program is giving error
Sub my()
Dim j As Integer
Dim i As Integer
For i = 1 To 8
For j = 1 To 4
If Sheet1.Cells(i, 1) <> Sheet2.Cells(j, 1) Then
Sheet1.Cells(i, 2) = Sheet2.Cells(j, 2)
End If
Next j
Next i
End Sub
it gives an error object required
can someone tell me what is wrong in it i am new in VBA
You can try like this:
Dim j As Integer
Dim i As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
For i = 1 To 8
For j = 1 To 4
If ws1.Cells(i, 1) <> ws2.Cells(j, 1) Then
ws1.Cells(i, 2) = ws2.Cells(j, 2)
End If
Next j
Next i
I have code here which loops through a list of files; opening them, extracting data and moving it into the main workbook. What i am looking to do get it so the data for abel is in columns c and d but then put varo in f and g etc. the problem that i see is that the placement code is inside the loop so for each i it will just write over the previous line instead of being in a different column all together!
Sub Source_Data()
Dim r
Dim findValues() As String
Dim Wrbk As Workbook
Dim This As Workbook
Dim sht As Worksheet
Dim i
Dim tmp
Dim counter
Dim c As Range
Dim firstAddress
Dim rng As Range
ReDim findValues(1 To 3)
findValues(1) = "abel"
findValues(2) = "varo"
findValues(3) = "Tiger"
counter = 0
r = Range("A1").End(xlDown).Row
Set rng = Range(Cells(1, 1), Cells(r, 1))
Set This = ThisWorkbook
For Each tmp In rng
Workbooks.Open tmp
Set Wrbk = ActiveWorkbook
Set sht = ActiveSheet
For i = 1 To 3
With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell))
Set c = .Find(findValues(i), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Offset(0, 2).Value
Do
This.Activate
tmp.Offset(0, 2).Value = tmp.Value
tmp.Offset(0, 3).Value = firstAddress
Set c = .FindNext(c)
counter = counter + 1
Loop While Not c Is Nothing And c.Value = firstAddress
End If
End With
Wrbk.Activate
Next
Wrbk.Close
Next tmp
End Sub
**EDIT:**I know it can be done by adding a multiplier of "i" to the offset value but this makes things bigger than they need to be if i wish to search for 50 keywords
Here is my answer, hope to help you, and as always, if you need an improvement, just tell me.
Sub Source_Data()
Dim r
Dim findValues() As String
Dim Wrbk As Workbook
Dim This As Workbook
Dim sht As Worksheet
Dim i
Dim tmp
Dim counter
Dim c As Range
Dim firstAddress
Dim rng As Range
Dim ColNum 'the columns number var
ReDim findValues(1 To 3)
findValues(1) = "abel"
findValues(2) = "varo"
findValues(3) = "Tiger"
counter = 0
r = Range("A1").End(xlDown).Row
Set rng = Range(Cells(1, 1), Cells(r, 1))
Set This = ThisWorkbook
For Each tmp In rng
Workbooks.Open tmp
Set Wrbk = ActiveWorkbook
Set sht = ActiveSheet
For i = 1 To 3
With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell))
Set c = .Find(findValues(i), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Offset(0, 2).Value
Do
This.Activate
Select Case i 'Test var i (the value)
Case "abel" 'in case the value (that is a string) is equal to...
ColNum = 1 'set the var, with the number of the column you want
Case "varo" 'in case the value...
ColNum = 2 'Set the column...
Case "Tiger"
ColNum = 3
Case Else 'In case that the i var not match with anyvalue take this column number
ColNum = 20 'the garbage!
End Select
tmp.Offset(0, ColNum).Value = tmp.Value 'Put the value in the selected columns
tmp.Offset(0, ColNum + 1).Value = firstAddress 'and put the value to the next column of the
'selected column
Set c = .FindNext(c)
counter = counter + 1
Loop While Not c Is Nothing And c.Value = firstAddress
End If
End With
Wrbk.Activate
Next
Wrbk.Close
Next tmp
End Sub
Note:
You need to set the ColNum var to the values that you need, put there the numbers of the columns you really need to store the value of i and the next line is to put the address of the i var
You can just change these two lines:
tmp.Offset(0, 2).Value = tmp.Value
tmp.Offset(0, 3).Value = firstAddress
To this
tmp.Offset(0, 2 + (i-1)*2).Value = tmp.Value
tmp.Offset(0, 3 + (i-1)*2).Value = firstAddress
I've tried to make this Auto Fill Range on VBA but I don't know What is Wrong or even if it works.
it should fill all the ranges A1 to Z20 based on first and second cells of each columns.
If anyone else can do it works or what's wrong please fix it.
Sub test()
Dim i As Range
Dim a As Long
Do While Not Range("Z20").Value > 0
If a = 0 Then
a = 1
Else
End If
For Each i In Range("A:Z")
a = a + 1
i = Range(Cells(1, a), Cells(20, a))
Cells(1, a).Value = 1
Cells(2, a).Value = 2
Set SourceRange = Range(Cells(1, a), Cells(2, a))
Set fillRange = Range(i).Columns(a)
SourceRange.AutoFill Destination:=fillRange
Next
Loop
End Sub
Option Explicit
Sub test()
Dim c As Range
Dim a As Long
Dim sourceRange As Range
a = 1
Do While a <> 20
ActiveSheet.Cells(1, a) = 1
ActiveSheet.Cells(2, a) = 2
Set c = ActiveSheet.Range(Cells(1, a), Cells(20, a))
Set sourceRange = ActiveSheet.Range(Cells(1, a), Cells(2, a))
sourceRange.AutoFill Destination:=c
a = a + 1
Loop
End Sub
I have use microsoft Excel Sheet ..I've fell different Values in excel sheet there is no problem..
but i've fell some numeric Columns like this (00023785678).. in this columns first zero is not get it..
so i went to change the column in cells format of text..
how to create in Vb.net code.. already i have fell excel sheet this method...
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim columnrange = oSheet.Columns
Dim therange = oSheet.UsedRange
' Dim wb As Microsoft.Office.Interop.Excel.Workbook
''Dim style As Microsoft.Office.Interop.Excel.Style
oXL = CreateObject("Excel.Application")
oXL.Visible = True
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
'oXL.Selection.num()
oXL.Selection.NumberFormat = "Text"
For c As Integer = 0 To dt.Columns.Count - 1
oSheet.Cells(1, c + 1).Value = dt.Columns(c).ColumnName
Next
For rCnt As Int16 = 2 To therange.Rows.Count
Dim rowArray(therange.Columns.Count) As String
For cCnt As Int16 = 1 To therange.Columns.Count
Dim Obj = CType(therange.Cells(rCnt, cCnt), Excel.Range)
Dim celltext As String
celltext = Obj.Value.ToString
rowArray((cCnt - 1)) = celltext
Next
Next
For r As Integer = 0 To dt.Rows.Count - 1
For c As Integer = 0 To dt.Columns.Count - 1
oSheet.Cells(r + 2, c + 1).Value = dt.Rows(r)(c)
oSheet.Cells(r + 2, c + 1).numberformat = "0"
Next
Next
'With oWB
' .Cells(seriesName.GetUpperBound(0) + 7, 3).numberformat = "#.00"
' .Cells(seriesName.GetUpperBound(0) + 7, 5).numberformat = "0"
'End With
'With oSheet.Range("A1", "ZZ1")
' .Font.Bold = True
' .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
' .HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
' .EntireColumn.AutoFit()
' .EntireRow.AutoFit()
'End With
Dim FirstRow As Long
Dim SecentRow As Long
Dim ThirdRow As Long
With oSheet.Range("A1", "BD1")
FirstRow = 1
SecentRow = 2
ThirdRow = 3
.Rows(0 + 1).EntireRow.Insert()
.Rows(0 + 1).EntireRow.Insert()
.Rows(0 + 1).EntireRow.Insert()
.Font.Bold = True
.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
.HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
.EntireColumn.AutoFit()
.EntireRow.AutoFit()
'.EntireRow.TextToColumns()
.Offset.Justify()
.Offset.BorderAround()
.Offset.WrapText = True
.Offset.Select()
End With
But right now idon't get the ans...
to pls help Me ...
Prefix the value in the cells you want to treat as text with a leading single quote '. This forces Excel to treat the cell as text, and the single quote will not be visible in the sheet.
oSheet.Range("A1", "BD1").NumberFormat = "#"
this will do the trick.