I am trying to hide multiple rows in an excel worksheet which are empty using following code however i am getting error message "Argument not optional". What could be wrong in the code?
Sub Attendance_Manday()
Dim sht1 As Worksheet
Dim row_count, col_count As Integer
Dim mainrange As Range
Dim startcell As Range
Set startcell = Range("B1")
Set sht1 = Sheets("Mandays")
row_count = Sheets("Mandays").Cells(Rows.Count, startcell.Column).End(xlUp).Row
col_count = Sheets("Mandays").Cells(startcell.Row, Columns.Count).End(xlToLeft).Offset(1, -2).Column
Set mainrange = sht1.Range(startcell.Address & ":" & sht1.Cells(row_count, col_count).Address)
mainrange.Range.SpecialCells(xlCellTypeBlanks).Rows.Hidden = True
End Sub
Based on your code and assuming first row in your sheet is never empty you could do something like that
Sub Attendance_Manday()
Dim sht1 As Worksheet
Dim row_count As Long, col_count As Long
Dim mainrange As Range
Dim startcell As Range
Set startcell = Range("B1")
Set sht1 = Sheets("Mandays")
row_count = Sheets("Mandays").Cells(Rows.Count, startcell.Column).End(xlUp).Row
col_count = Sheets("Mandays").Cells(startcell.Row, Columns.Count).End(xlToLeft).Offset(1, -2).Column
Set mainrange = sht1.Range(startcell.Address & ":" & sht1.Cells(row_count, col_count).Address)
Dim i As Long
For i = 1 To col_count - 1
mainrange.AutoFilter field:=i, Criteria1:="="
Next i
Dim rg As Range
Set rg = mainrange.SpecialCells(xlCellTypeVisible)
mainrange.AutoFilter
rg.Rows.EntireRow.Hidden = True
rg.Rows(1).EntireRow.Hidden = False
End Sub
An if you turn off screenupdating etc. it should be pretty fast as well
picture of sheet where I want to take the values from.
I have a sheet where I want to iterate through one column. Column "E" in sheet3. There are many duplicates in this column. It must take the value, and insert it into sheet1 column "C". It is important that I do not have duplicates in sheet1. I have tried to solve this problem using dictionaries. But I cannot get it to work. Can someone help me?
This is the code i got for now. I am stuck and can not get further.
Sub test()
Const START_ROW = 11
Const MAX_ROW = 40
Const CODE_SHT1 = "C"
Const CODE_SHT4 = "E"
Const CVR_SHT4 = "C"
Const CVR_SHT3 = "C"
Const BROKER_SHT4 = "E"
' sheet 4 columns
'C - Employer CVR MD
'D - Employer name
'E - broker code
'F - Broker name
'? Employer CVR CER
Dim wb As Workbook, wbNew As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, wsNew As Worksheet
Dim iRow As Long, iLastRow, iTargetRow As Long, iCopyRow As Long
Dim msg As String, i As Integer, j As Integer
Dim count As Long, countWB As Integer
Dim WkSht_Src As Worksheet
Dim WkBk_Dest As Workbook
Dim WkSht_Dest As Worksheet
Dim Rng As Range
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("BrokerSelect")
Set ws3 = wb.Sheets("ContributionExceptionReport")
Set ws4 = wb.Sheets("MasterData")
Dim dict As Object, dictCVR As Object, dictBROKER As Object, sKey As String, ar As Variant
Dim sCVR As String, arCVR As Variant
Dim sBROKER As String, arBROKER As Variant
Set dict = CreateObject("Scripting.Dictionary")
Set dictCVR = CreateObject("Scripting.Dictionary")
Set dictBROKER = CreateObject("Scripting.Dictionary")
' Get broker code + broker name from sheet 3 and insert into sheet one
iLastRow = ws4.Cells(Rows.count, BROKER_SHT4).End(xlUp).Row
For iRow = 18 To iLastRow
sKey = ws4.Cells(iRow, BROKER_SHT4)
If dictBROKER.exist(sKey) Then
dictBROKER(sKey) = dictBROKER(sKey) & ";" & iRow ' matched row on sheet 1
Else
dictBROKER(sKey) = iRow
End If
MsgBox (dict(sKey))
Next
End Sub
your code has to be amended from (at least):
a Next statament more (that by the end)
use of dict instead of dictBROKER
incorrect indentation (to have more chance to understand and control it)
so here it is after those changes
Sub Test()
Const START_ROW = 11
Const MAX_ROW = 40
Const BROKER_SHT4 = "E"
Dim wb As Workbook, wbNew As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, wsNew As Worksheet
Dim iRow As Long, iLastRow, iTargetRow As Long, iCopyRow As Long
Dim msg As String, i As Integer, j As Integer
Dim count As Long, countWB As Integer
Dim WkSht_Src As Worksheet
Dim WkBk_Dest As Workbook
Dim WkSht_Dest As Worksheet
Dim Rng As Range
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("BrokerSelect")
Set ws3 = wb.Sheets("ContributionExceptionReport")
Set ws4 = wb.Sheets("MasterData")
Dim dictBROKER As Object, dictCVR As Object, sKey As String, ar As Variant
Dim sCVR As String, arCVR As Variant
Dim sBROKER As String, arBROKER As Variant
Set dictBROKER = CreateObject("Scripting.Dictionary")
' Get broker code + broker name from sheet 3 and insert into sheet one
iLastRow = ws4.Cells(Rows.count, BROKER_SHT4).End(xlUp).Row
For iRow = 13 To iLastRow
sKey = ws4.Cells(iRow, BROKER_SHT4)
If dictBROKER.exists(sKey) Then
dictBROKER(sKey) = dictBROKER(sKey) & ";" & iRow ' matched row on sheet 1
Else
dictBROKER(sKey) = iRow
End If
MsgBox (dictBROKER(sKey))
Next
' add cvr records from sheet3 if any
sBROKER = ws4.Cells(iCopyRow, BROKER_SHT4)
If dictBROKER.exists(sBROKER) Then
arBROKER = Split(dictBROKER(sBROKER), ";")
For j = LBound(arBROKER) To UBound(arBROKER)
If j > 0 Then iTargetRow = iTargetRow + 1
' copy col C to D
iCopyRow = arBROKER(j)
Debug.Print sBROKER, j, iCopyRow
Next
Else
count = count + 1
End If
End Sub
Sub exportSheet2()
Const START_ROW = 11
Const MAX_ROW = 40
Const BROKER_SHT4 = "E"
Dim wb As Workbook, wbNew As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, wsNew As Worksheet
Dim iRow As Long, iLastRow, iTargetRow As Long, iCopyRow As Long
Dim msg As String, i As Integer, j As Integer
Dim count As Long, countWB As Integer
Dim WkSht_Src As Worksheet
Dim WkBk_Dest As Workbook
Dim WkSht_Dest As Worksheet
Dim Rng As Range
Dim r As Long
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("sheet1")
Set ws3 = wb.Sheets("sheet3")
Set ws4 = wb.Sheets("sheet4")
Dim dict As Object, dictCVR As Object, sKey As String, ar As Variant
Dim sCVR As String, arCVR As Variant
Dim sBROKER As String, arBROKER As Variant
Set dict = CreateObject("Scripting.Dictionary")
Set dictCVR = CreateObject("Scripting.Dictionary")
Set dictBROKER = CreateObject("Scripting.Dictionary")
' Get broker code + broker name from sheet 3 and insert into sheet one
iLastRow = ws4.Cells(Rows.count, BROKER_SHT4).End(xlUp).Row
r = 11
For iRow = 13 To iLastRow
sKey = ws4.Cells(iRow, BROKER_SHT4)
If dictBROKER.exists(sKey) Then
dictBROKER(sKey) = dictBROKER(sKey) & ";" & iRow ' matched row on sheet 1
Else
dictBROKER(sKey) = iRow
ws1.Range("E" & r) = sKey
ws1.Range("F" & r) = ws4.Cells(iRow, "F")
r = r + 1
End If
Next
I am new to VBA Coding but have managed to fumble my way through.
I have found this and modified to my requirements but I want to specify the range of columns to copy which are A to Q.
Any help would be appreciated.
Sub SplitData_ToPLCSheets()
'Split KEPServerCombined Column r into Separate Sheets ready for Export (PLC Name)
Const NameCol = "R"
Const HeaderRow = 1
Const FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim PLC As String
Excel_Tools.TurnEverythingOff ' Turn off Calc , Screen Updating and `enter code here`Calcs
Set SrcSheet = ThisWorkbook.Sheets("KEPServerCombined")
'Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).row
For SrcRow = FirstRow To LastRow
PLC = SrcSheet.Cells(SrcRow, NameCol).value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(PLC)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.name = PLC
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
Excel_Tools.TurnEverythingOn ' Turn on Calc , Screen Updating and Calcs
End Sub
thanks for your help - finally sussed out an Answer which works but slow for 30000 rows
Sub SplitData_ToPLCSheets()
'Split KEPServerCombined Column r into Separate Sheets ready for Export (PLC Name)
Const SrcCol_PLC = "R"
Const SrcRow_Headers = 1
Const SrcRow_FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.name = TrgName
SrcRange = "A" & Trim(Str(SrcRow_Headers)) & ":Q" & Trim(Str(SrcRow_Headers))
TrgRange = "A1"
SrcSheet.Range(SrcRange).Copy Destination:=TrgSheet.Range(TrgRange)
End If
' update the target row number to the first empty row on the target worksheet and copy data across
Set TrgSheet = Nothing
Set TrgSheet = Worksheets(TrgName)
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, 1).End(xlUp).Offset(1).Row
SrcRange = "A" & Trim(Str(SrcRow)) & ":Q" & Trim(Str(SrcRow))
TrgRange = "A" & Trim(Str(TrgRow))
SrcSheet.Range(SrcRange).Copy Destination:=TrgSheet.Range(TrgRange)
SrcRow = SrcRow + 1
DoEvents
Loop
Excel_Tools.TurnEverythingOn ' Turn on Calc , Screen Updating and Calcs
End Sub
My code currently searches through Sheet1 and copies rows into Sheet2 if it matches the array of strings in strSearch. How can I make it so that it outputs "No Search Found" as a row on Sheet2 if there are no rows that contain the strSearch?
Dim ws1 As Worksheet, ws2 As Worksheet
Dim firstRowWs1 As Long
Dim lastRowWs1 As Long
Dim lastRowWs2 As Long
Dim searchColumnWs1 As Integer
Dim i As Integer
Dim check As Variant
Dim strSearch As Variant
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
With ws2
lastRowWs1 = ws1.UsedRange.Rows.Count
lastRowWs2 = ws2.UsedRange.Rows.Count
firstRowWs1 = 1
searchColumnWs1 = 10
strSearch = Array("John", "Jim")
For i = firstRowWs1 To lastRowWs1
For Each check In strSearch
If check = ws1.Cells(i, searchColumnWs1).Value Then
ws1.Rows(i).Copy (ws2.Rows(lastRowWs2 + 1))
ws2.Rows(lastRowWs2 + 1).Columns("A:B").Insert xlToRight
lastRowWs2 = lastRowWs2 + 1
ws1.Rows(i).Delete shift:=xlUp
i = i - 1
Exit For
End If
Next check
Next i
End With
Keep track of whether or not you found matches, and add the text after your loop.
Eg:
Dim foundMatches as Boolean
foundMatches = False
For i = firstRowWs1 To lastRowWs1
For Each check In strSearch
If check = ws1.Cells(i, searchColumnWs1).Value Then
foundMatches = True
... etc
End If
Next check
Next i
If Not foundMatches then
' print "no rows found" somewhere
end if
I want to retrieve the data in listview from below path instead of same file. Can you please advise as to what all changes are required in my code.
myFileNameDir = "C:\Users\GShaikh\Desktop\Book16.xlsx"
Workbooks.Open Filename:=myFileNameDir, UpdateLinks:=0
Set ws1 = Worksheets("Students")
'Code for retrieving data from same file.
Dim wksSource As Worksheet
Dim rngData As Range
Dim rngCell As Range
Dim LstItem As ListItem
Dim RowCount As Long
Dim ColCount As Long
Dim i As Long
Dim j As Long
Set wksSource = Worksheets("Sheet1")
Set rngData = wksSource.Range("A1").CurrentRegion
For Each rngCell In rngData.Rows(1).Cells
Me.ListView1.ColumnHeaders.Add Text:=rngCell.Value, Width:=90
Next rngCell
RowCount = rngData.Rows.Count
ColCount = rngData.Columns.Count
For i = 2 To RowCount
Set LstItem = Me.ListView1.ListItems.Add(Text:=rngData(i, 1).Value)
For j = 2 To ColCount
LstItem.ListSubItems.Add Text:=rngData(i, j).Value
Next j
Next i
You add the data to the ListView from the rngData Range, and here is where you set up that Range:
Set rngData = wksSource.Range("A1").CurrentRegion
If you want to use the data from the workbook that you opened, you should modify rngData to refer to that workbook instead:
Set rngData = ws1.Range("A1").CurrentRegion