i am new to vba,here i am explaining my situation
1,i want know how to form array in vba with index 1
2,How to give array to remove duplicates**
i want give remove multiple columns in sheet,dynamically i mean if sheet contain 5 rows i want to give (1,2,3,4,5) if sheet contain 3--(1,2,3)
here my code:
Dim darray() As Integer
For i = 1 To LastCol1
ReDim Preserve darray(i)
darray(i) = i
Next i
wsDest.Range("A1" & ":" & Cells(LastRow1, LastCol1).Address).RemoveDuplicates Columns:=(darray), Header:=xlYes
wsDest.Range("A1" & ":" & Cells(LastRow1, LastCol1).Address).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
with this code i am get error : invalid procedure call oenter code herer argument
below code is to conscile data from all files in folder and sort data and remove duplicates finally want to create pivot table
Sub LoopAllFilesInAFolder()
Dim FolderPath As String
Dim Filename As String
Dim lDestLastRow As Long
FolderPath = "D:\surekha_intern\vba macro learning\assignment\students_data_a3\"
Set wsDest = Workbooks("VBA_A3.xlsm").Worksheets("sheet1")
Filename = Dir(FolderPath)
While Filename <> ""
'Debug.Print Filename
'Workbooks.Open Filename:=FolderPath & Filename
Set wb = Workbooks.Open(FolderPath & Filename)
If WorksheetFunction.CountA(ActiveSheet.UsedRange) = 0 And ActiveSheet.Shapes.Count = 0 Then
Debug.Print Filename; " is empty"
Else
Dim LastRow As Long
Dim Lastrow_te As Long
With wb.Sheets(1)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'down
Lastrow_te = .Range("A99999").End(xlUp).Row
'Rows.Count, "A"
MsgBox Lastrow_te
End With
Dim LastCol As Integer
With wb.Sheets(1)
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
' MsgBox LastCol
End With
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(0).Row
' MsgBox lDestLastRow
'Range("a1:a10").Copy
'Range("a1:a10").PasteSpecial
'Application.CutCopyMode = False
If lDestLastRow = 1 Then
'MsgBox "HI" '.Range("A" & LastRow & LastCol)'"A" & lastRow & ":" & Cells(lastRow, lastCol).Address
wb.Sheets("Sheet1").Range("A1" & ":" & Cells(LastRow, LastCol).Address).Copy '"A" & LastRow & LastCol ----"A" & LastRow, LastCol
wsDest.Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Else
wb.Sheets("Sheet1").Range("B1" & ":" & Cells(LastRow, LastCol).Address).Copy
Workbooks("VBA_A3.xlsm").Sheets("sheet1").Range("A" & lDestLastRow + 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
'MsgBox wsDest.Range("A" & lDestLastRow)
'wb.Sheets("Sheet1").Range("A" & LastRow & LastCol).Copy Destination:=wsDest.Range(A & lDestLastRow)
End If
End If
' ActiveSheet.Close
wb.Close False
Filename = Dir
Wend
Workbooks("VBA_A3.xlsm").Save
Dim LastRow1 As Long
With wsDest
LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row 'down
'Rows.Count, "A"
' MsgBox LastRow
End With
Dim LastCol1 As Integer
With wsDest
LastCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
' MsgBox LastCol
End With
'SORTING
With wsDest.Sort
.SortFields.Add Key:=Range("A1:A" & LastRow), Order:=xlAscending
.SetRange Range("A1" & ":" & Cells(LastRow1, LastCol1).Address)
.Header = xlYes
.Apply
End With
'duplicates remove
' Dim darray() As Integer
'For i = 1 To LastCol1
' ReDim Preserve darray(i)
' darray(i) = i
' Next i
'MsgBox darray()
'wsDest.Range("A1" & ":" & Cells(LastRow1, LastCol1).Address).RemoveDuplicates Columns:=(darray), Header:=xlYes
'ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
'TEXT EFFECTS
Dim colm As String
Select Case LastCol1
Case 1
colm = "a1"
Case 2
colm = "b1"
Case 3
colm = "c1"
Case 4
colm = "d1"
Case 5
colm = "e1"
End Select
wsDest.Range("a1:" & colm).Interior.ColorIndex = 5
wsDest.Range("a1:" & colm).Font.Bold = True
wsDest.Range("a1:" & colm).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
wsDest.Range("a1:" & colm).Font.Size = 15
'CREATE PIVOT
'Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R39C4", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Sheet6!R3C1", TableName:="PivotTable2", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Sheet6").Select
Cells(3, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Subject")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("marks"), "Sum of marks", xlSum
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Student name")
.Orientation = xlPageField
.Position = 1
End With
MsgBox "Process done"
End Sub
thanks n advance,
The Three Conditions
Variant (as you didn't).Evaluate or () (as you did).Also
wsDest.Cells..., wsDest.Range...Hardly Related
RemoveDuplicates to only some of the columns, then using VBA with the Array function will ensure a zero-based array (Option Base related) e.g. dArray = VBA.Array(1, 3, 4).A Quick Fix
Sub removeDupes()
Dim darray() As Variant: ReDim darray(0 To LastCol1 - 1)
For i = 0 To LastCol1 - 1
darray(i) = i + 1
Next i
wsDest.Range("A1", wsDest.Cells(LastRow1, LastCol1)) _
.RemoveDuplicates Columns:=(darray), Header:=xlYes
End Sub
Another Example
Add a new workbook. Add a module. Copy the code to the module. In Sheet1 create a table (means headers, not necessarily an Excel Table), starting in A1, with 5 rows and 4 columns. Use the same data in 2 or more rows (the same for all columns), run the following procedure and see how only one of 'same-data' rows remains. It also includes an optional 'loop handling'.
Option Explicit
Sub removeDupes()
Dim LastRow1 As Long: LastRow1 = 5
Dim LastCol1 As Long: LastCol1 = 4
Dim arr As Variant: ReDim arr(0 To LastCol1 - 1)
Dim i As Long
For i = 1 To LastCol1
arr(i - 1) = i
Next i
Sheet1.Range("A1", Sheet1.Cells(LastRow1, LastCol1)) _
.RemoveDuplicates Columns:=(arr), Header:=xlYes
End Sub