I am new to vbscript and I am creating a script to reduce my day by day duplicate efforts. I have a column in an excel sheet which holds values. There are certain cells under this column where multiple values exists. Now I have an array which has some values which needs to be looked up / searched within each row under this column and delete the row if array values are not present within the row.
I tried to search the array values in the rows using InStr function and it worked if cell contains only one value. Code is attached below.
This sub is not working as expected if cell contains multiple values. e.g. Project 1 [ALT + ENTER] Dummy Project
Hence I tried to use Find and Search methods. I am unable to get the expected results using these methods too.
Fix Version/s
Row 1 - Project 3 a
Row 2 - Project 2 'spaces at the end
Row 3 - Project 4
---------
Project 1
Row 4 - Project 5
Row 5 - Project 1
Find method - No rows deleted
Replace method - Getting syntax error where I used Search method in place of InStr function as below,
If objWorksheet1.Cells(iDelCnt, fixVerColNum).Search(objWorksheet1.Cells(iDelCnt, fixVerColNum).Value, projectFilter(jDelCnt)) <> 0 Then
Please assist. Thanks in advance.
Expected - I expect row 'x' to be deleted if array value doesn't exists in Cells(x,y)
Dim objExcel, objWorkbook, objWorksheet1
Dim iDelCnt, jDelCnt, projectFilter, lRow, fixVerColNum, tempCell, deleteCounter, InStrTest
Set objExcel = CreateObject("Excel.Application")
objExcel.Application.Visible = True
Set objWorkbook = objExcel.Workbooks.Open(filePath) ' Location of the file on drive
Set objWorksheet1 = objWorkbook.Worksheets(1)
projectFilter = Array("Project 1","Project 2", "Project 3")
fixVerColNum = objExcel.Match("Fix Version/s", objWorksheet1.Range("A1:T1"), 0) 'Identify "Fix Version(s)" column number
lRow = objWorksheet1.Range("A1").CurrentRegion.Rows.Count
deleteCounter = 0
For iDelCnt = lRow to 2 Step -1
For jDelCnt = LBound(projectFilter) to UBound(projectFilter)
If InStr(1, objWorksheet1.Cells(iDelCnt, fixVerColNum).Value, projectFilter(jDelCnt), 1) <> 0 Then
deleteCounter = 1
Exit For
Else
deleteCounter = 0
End If
Next
If deleteCounter = 0 Then
objWorksheet1.Rows(iDelCnt).EntireRow.Delete
End If
Next
Related
i wanna to look for sheet 2 column H value in sheet 1 column A and then copy and paste matching data from sheet 1 to sheet 2 column A last empty row.. had written below VBA but somehow not all matching line can be copied and paste from sheet 1.. and for those just newly copy and paste from sheet 1 data, is carrying value for column H, again i need to look for this column H new data from sheet 1 and then copy and paste to sheet 2 (repeat same action)...how to write VBA for doing this continuos action then VBA stop when all column H data is already referenced and having copy and paste line from sheet1?
Had tried to write below VBA according to i wanna to achieve result.
Sub MatchData()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long, lastRowA As Long
Dim i As Long, j As Long
Dim matchFound As Boolean
'Set worksheet variables
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
'Get last row for both sheets
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "H").End(xlUp).Row
'Get last row in Sheet2 column A
lastRowA = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'Loop through Sheet2 column H data and match with Sheet1 column A
For i = 1 To lastRow2
matchFound = False 'Reset matchFound flag for each row
If Not IsEmpty(ws2.Cells(i, 8)) Then 'Check if Sheet2 column H cell is not empty
For j = 1 To lastRow1
If ws2.Cells(i, 8) = ws1.Cells(j, 1) And ws2.Cells(i, 9) = ws1.Cells(j, 2) Then 'Match found
matchFound = True
'Check if matching row is a duplicate
If WorksheetFunction.CountIf(ws2.Range("A1:B" & lastRowA), ws1.Cells(j, 1).Value & ws1.Cells(j, 2).Value & ws2.Range("A" & i).Value & ws2.Range("B" & i).Value) = 0 Then
'Copy matching row to Sheet2 column A last empty row
ws1.Rows(j).EntireRow.Copy ws2.Cells(lastRowA + 1, "A")
lastRowA = lastRowA + 1 'Update last empty row in Sheet2 column A
End If
End If
Next j
End If
Next i
MsgBox "Matching and copying rows completed!"
End Sub
My code takes a file name from TextBox1, opens that file and indexes through all the unique values in column B. It then takes a second file, file name in TextBox2, and filters it based on the current index from the first file. It then takes the filtered results and copies them to a sheet in the new workbook. A new sheet is then generated in the new workbook to paste the next filtered result.
My issue is that I have many rows of data and for some reason the filtered data is not be selected after many iterations. My program selects all filtered data when it starts, but at some point it just begins selecting the headers instead of all the visible cells. Let me know if I am missing something or if there is a quick workaround. Thank you.
Sub NewFileGenerate()
Dim I As Integer
Dim N As Integer
Dim X As Integer
Dim IndexedCell As String
X = 1
Windows(TextBox1.Value).Activate
'Need to count only populated cells
I = Sheets(1).Columns(2).Cells.SpecialCells(xlCellTypeConstants).Count
Set Newbook = Workbooks.Add
For N = 2 To I - 1
Application.CutCopyMode = True
Windows(TextBox1.Value).Activate
IndexedCell = Cells(N, 2).Value
Windows(TextBox2.Value).Activate
With Sheets(1)
With .Range("A1", "Z" & I - 1)
.AutoFilter Field:=5, Criteria1:=IndexedContract
.SpecialCells(xlCellTypeVisible).Copy
End With
End With
Newbook.Activate
ActiveSheet.Paste Destination:=Sheets(X).Range("A1:Z1")
Cells.Select
Selection.Font.Size = 10
Cells.EntireColumn.AutoFit
Cells.Select
X = X + 1
If X > 3 Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet" & X
End If
Application.CutCopyMode = False
Next N
End Sub
I'm guessing that your source worksheet (textbox2.value) has more rows than your index worksheet (textbox1.value). You set I equal to the number of rows in your index worksheet, then you tell the autofilter to only use that number of rows. You need to change the line "With .Range("A1", "Z" & I - 1)" so it picks up all of the rows in your source worksheet.
I am new to scripting and perform lot of activity as an analyst using excel sheets.
I have two files with list of items in it.
File1 contains 1 column
File2 contains 2 columns.
I want to check if the list present in column1 of file2 is same as in column1 of file2. If yes then it should print column1File1, column1File2 and coulmn2File2 in file3 else it should print "NA", column1File2, column2File2 in file3.
Please help, It will simplify my work a lot.
I made this program a while ago, although it will iterate through sheets in 1 workbook, and compare cell by cell, it may set you in the right direction. It would take a cell in 1 "master" sheet and then iterate through each sheet to find that in a particular column. After it found it the counter would increment, then it would take the next cell in the master sheet and so on. you could alter to use multiple books and take whatever cells you want and compare them.
Sub Open_Excel()
'Use worksheetNum as sheet to read/write data
Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(worksheetNum)
'How many rows are used in the current worksheet
usedRowsCount = currentWorkSheet.UsedRange.Rows.Count
'Use current worksheet cells for values
Set Cells = currentWorksheet.Cells
'Loop through each row in the worksheet
For curRow = startRow to (usedRowsCount)
'Get computer name to ping to
strEmailAddressSource = Cells(curRow,colEmailAddressSource).Value
strServerSource = Cells(curRow,colHostserverSource).Value
strLocationSource = Cells(curRow,colLocationSource).Value
'make the values unique
strconcatenation = strServerSource & strLocationSource
Call Comparison()
Next
End Sub
'********************************************************************************************
'**** Comparison
'********************************************************************************************
'Comparison test
Sub Comparison()
'choose the worksheets to go through
For worksheetCounter = 6 to 9 'workSheetCount
Set currentWorkSheetComparison = objExcel.ActiveWorkbook.Worksheets(worksheetCounter)
usedRowsCountNew = currentWorkSheetComparison.UsedRange.Rows.Count
'First row to start the comparison from
For rowCompare = 2 to (usedRowsCountNew)
strEmailLot = currentWorkSheetComparison.Cells(rowCompare,colEmailAddressLot).Value
comp1 = StrComp(strEmailAddressSource,strEmailLot,0)
comp2 = StrComp(strconcatenation,reportConcat,0)
'check if the values match
If ((comp1 = 0) AND (comp2 = 0)) THEN
countvalue = countvalue + 1
End If
Next
Next
End Sub
am using two datatable named as dnddatatable and dtdup . it contains set of phone numbers . I want to compare 2nd datatable with first datatable and remove the values from datatable1(name as dnddatatable)values which are equal to 2nd datatable name as(dtdup).
data in the datatable as follows.
dnddatatable(data table1)
phone
9865015695
9840903331
98668625
800971868
809679532
837445478
dtdup(dtata table2)
phone_numbers
9865015695
9840903331
result dnddatatable(data table1)
98668625
800971868
809679532
837445478
I answered a pretty similar question time ago, the idea is exactly the same
For i As Integer = 0 To dataset.Tables(0).Rows.Count - 1
Dim found As Boolean = False
For j As Integer = 0 To dataset1.Tables(0).Rows.Count - 1
If dataset.Tables(0).Rows(i)(0).ToString = dataset1.Tables(0).Rows(j) (0).ToString Then
found = True
End If
Next
If found = False Then
'here you are getting the right result in each loop
'in this example i'm showing the result in a textbox
'just change the instruction and write them in your note pad or wherever you want to
MsgBox(dataset.Tables(0).Rows(i)(0).ToString)
End If
Next
So i have FlexGrid in my VB6 project I'm working on. It has names on each row, and I have a drop down so the user can select what name they want to see more info for, here is what I have.
Dim target_name As String
Dim r As Integer
' Get the name.
target_name = Combo1
If Len(target_name) = 0 Then Exit Sub
' Search for the name, skipping the column heading row.
target_name = LCase$(target_name)
For r = 1 To MSFlexGrid1.Rows - 1
If LCase$(MSFlexGrid1.TextMatrix(r, 0)) = _
target_name Then
' We found the target. Select this row.
MSFlexGrid1.Row = r
MSFlexGrid1.RowSel = r
MSFlexGrid1.Col = 0
MSFlexGrid1.ColSel = MSFlexGrid1.Cols - 1
' Make the row visible.
MSFlexGrid1.TopRow = r
Exit Sub
End If
Next r
That works well, but it shows everything below that name too, I would like it to single out only the name selected.
Any help would be great.
What's the data source of your grid? You can place the filter on the data grid data source, so that as the user chooses the name from your drop down only the selected persons details are returned from the datasource to the grid.
Not exactly what you were asking, but its how I would achieve the result you are wanting.
P.S. I have used FlexGrid in VB6 and I don't know of a way to do what you are asking on the grid (might be there but I never noticed it).