How to find if the column exists in Excel through VBA - vba

I have two headers in two rows in my excel based on which i upload values for each row. if the combination of two headers is already available, the values will be updated in that row. If that combination is not available a new column will be created.
Sample Excel
As in the image, If i find Column 2 and Column B combination again i can update value in a new row against Column 2 and Column B. If there is another combination of headers say, Column 5 and column B, then it will create a new column.
Using VBA i am able to check only one column header but not the combination of the headers. i used the below code.
Set c=ws.Range("B2",ws.Cells(2,Columns.Count)).Find:=What(d,1)
IF c is Nothing Then
My code
Else`My Code End If

Find can't be used to find values spread over several cells. I suggest this kind of code.
Private Sub FindMatchingColumn()
' 24 May 2017
Dim Caption1, Caption2
Dim Combination As String
Dim Captions As String
Dim C As Long
Caption1 = "Column A"
Caption2 = "Column 1"
Combination = CStr(Caption1) & CStr(Caption2)
With ActiveSheet
Do
C = C + 1
Captions = CStr(.Cells(1, C).value) & CStr(.Cells(2, C).value)
If StrComp(Captions, Combination, vbTextCompare) = 0 Then Exit Do
Loop While Len(Captions)
If Len(Captions) Then
MsgBox "Column " & C & " has matching captions"
Else
MsgBox "No matching captions were found" & vbCr & _
"Write new captions to Column " & C
.Cells(1, C).value = Caption1
.Cells(2, C).value = Caption2
End If
End With
End Sub
Caption1 and Caption2 are the two column headers you are looking for. The first part of the code loops through all the columns to find that combination. If it is found it passes the column where it was found to the following code. If not, it passes the number of the next blank column.
The second part takes that column number and acts upon it. If it is a used column you can add your value there. If it is a new column it adds the two captions and then you can add your values in it.
This code presumes that you know the sequence of the captions. If you need to accept either A + B or B + A both values must be checked before passing to the next column in the Do loop.

Related

How to add rows based on the number of criteria in a column in VBA?

I have been trying to figure this problem out for a while but I cannot think of an answer. Some context here: I have two worksheets. In sheet one, I have a column that is full of names. In the second sheet, I have an outline that has 10 rows that display the names. However, if in sheet one there are 11 names, the 11th name would not appear in sheet two because there are only 10 rows. What I need to figure out is how to insert a row for the 11th names (or nth depending on how many names are added). Once I add the nth row, I would auto fill the formula down which is the easy part. The part I cannot figure out is how to insert the row.
What I was thinking was inserting a COUNT function that would count the different names and insert the rows that way. But is there a way I could do it so there would not be a random number (the number being the COUNT) in a cell in one of my worksheets?
From my understanding, you want to insert n-10 number of rows with n being total number of rows of names.
Try this
Sub test()
Dim startr, endr As Range
Set startr = Range("A7") 'Set this to be the first row of your list of names
If Not startr.Value = "" Then
With Sheets("Sheet1")
Do Until startr.Offset(i).Value = ""
i = i + 1
Loop
End With
Set endr = startr.Offset(i - 1) 'endr is now the last row of the names
totalr = Range(startr, endr).Rows.Count 'totalr is the total number of rows/names
If totalr > 10 Then
addr = totalr - 10 'addr is the number of rows you need to add
MsgBox "You need to insert " & addr & " more rows."
'The following finds the last row of column A and inserts addr number of rows
Dim lastr As Range
Set lastr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)
lastr.Offset(1).EntireRow.Resize(addr).Insert
Else
MsgBox "Number of rows/names is " & totalr & " which is less than 10, so no rows are being added."
End If
Else
MsgBox startr.Address(0, 0) & " is empty."
End If
End Sub

VBA Use one column from multi column combo box as variable

I have the following code that produces a multi column combo box in a userform showing the Client and ID. I had to produce both columns as the Client and be listed multiple times but the ID is unique.
i = 2
For Each c In Range("D2", Range("D" & Rows.Count).End(xlUp))
CB_Account.AddItem Cells(i, 4).Value & " : " & Cells(i, 3).Value
i = i + 1
Next
However I'm using the value selected filter a sheet so that I can copy client details to a new sheet and am using the selected value as a variable:
MyAccount = UF_Format.CB_Account.Value
The code is currently falling over because the value in the combobox in a concatenation of two columns. Really I need to pull through just the second value being the ID so my code can filter.
Any help would be much appreciated.
You can declare the variable MyAccount as an array, then split the combo box value using colon as the delimiter. You can then work with the second item of the array.
Sub second_value()
Dim MyAccount() As String
MyAccount = Split(UF_Format.CB_Account.Value, " : ")
Debug.Print MyAccount(1)
End Sub

Returning a quick statistical info for a cell as a comment

I have a long list of data on an excel table. This data includes detail information of each order in several rows. There is a column shows the status of each row. Also, I have a dashboard which just lists out the order names. I want the users to be able to see a short statistical info of each book as a comment or when they mouse over the cell, if possible or as a cell data. The info could be something like underneath sample in 3 or 4 row. (The number of items is the count of rows with the same status)
5 issued item
3 shortage items
2 Done items
X other
If you just give me the general idea it would be great.
I think I have to use a collection procedure, something like "scripting dictionary" but I have no experience using them. I know how to do that by putting a case statement after if clause inside a loop, but I am looking for a smarter way. you can find some pictures and a sample data below: sample pictures
For the record, I came to this answer from one of friends in MrExcel froum. Hope you find it usefull.
The just difference is, I was looking for a momentum reply just for an active cell, but this code, provide all the information for all the order names as a comment. but it is very easy to adjust!
Sub UpdateComments()
Dim c As Variant, strComment As String
Dim intISSUED As Integer, intSHORTAGE As Integer
Dim tblDATA As ListObject, tblDASH As ListObject
Set tblDATA = Application.Range("TBL.data").ListObject 'adjust Table Name
Set tblDASH = Application.Range("TBL.dash").ListObject 'adjust Table Name
For Each c In tblDASH.ListColumns("W/B").DataBodyRange
strComment = ""
intISSUED = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c, tblDATA.ListColumns("Stage").DataBodyRange, "Issued")
strComment = strComment & Chr(10) & "Issued: " & intISSUED
intSHORTAGE = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c,tblDATA.ListColumns("Stage").DataBodyRange, "Shortage")
strComment = strComment & Chr(10) & "Shortage: " & intSHORTAGE
' ADDITIONAL 'STAGES' HERE
' OR put 'stages' in array to condense code
With Sheets(tblDASH.Parent.Name).Range(c.Address)
If .Comment Is Nothing Then
.AddComment
.Comment.Visible = False
End If
.Comment.Text Text:=Mid(strComment, 2)
End With
Next c
End Sub

Prevent merged cells splitting between pages

I am trying to write a program to create a Microsoft Word document from an Oracle table.
The document has tables with the left hand column which represents group field name and the next column has some fields associated with that group. I don't want the groups to split across pages. My code for doing this doesn't appear to work - the groups are still split across pages.
Does anyone know how to do this?
'output table data - data gets loaded into the display table starting at row 3
'(row 1 and 2 are the headers)
For row = 3 To maxrows + 2
Dim dataRow = dsHDTabCols.Tables(0).Rows(row - 3) 'dataset has rows to output
If dataRow("KEEP_WITH_NEXT_FLAG") & "" = "K" Then
oTable.Cell(row, 1).Range.ParagraphFormat.KeepWithNext = True
End If
If dataRow("GROUP_NAME") & "" = "#ditto#" Then
VerticalMergeWithPriorRow(oTable, row, 1)
Else
oTable.Cell(row, 1).Range.Text = dataRow("GROUP_NAME") & ""
End If
oTable.Cell(row, 2).Range.Text = dataRow("COLUMN_NAME") & ""
Note that I am vertically merging cells, so I am limited to using the table.cell references.
Table.rows(nnn)` gives an exception.
The data processed by the code above starts with a data row with the keep_with_next_flag set to "K", so the code sets the cell paragraph format keepwithnext = true.
The next data row in a group would come with the group name = "#ditto#" and a keep_with_next_flag set to "K". As above, the code sets the cell paragraph format with keepwithnext = true. Since it's a ditto, the code will execute the VerticalMergeWithPriorRow function which just merges the current cell with the cell in the same column, but prior row.

Delete row in Excel if a cell does not contain a specific value

I have a worksheet, i need deleted all rows that not contain the phrase "#" on column G until column K.
This is sample data i have
if cell on Column G until Column K not containing "#", Delete Rows
please help me..
You will have to use several loop commands. Begin by looping through the records that you want to process. Here is an outline of pseudo-code.
loop through the columns that you want to process, G through K
read the value of the cell as a string
initialize variable atdetector = "dunno_yet"
loop through each character of the string
if any character = "#"; then atdetector = "found"
After looping through each column, if atdetector = "dunno_yet", then "#" was never found. Delete the row. Repeat until there are no more rows.
The following macro scans from row 2 and removes rows where columns 2-5 do not contain an #:
Sub Macro1()
CurRow = 2
While CurRow < Application.WorksheetFunction.CountA(Range("A:A")) + 1
If InStr(1, _
Sheet1.Cells(CurRow, 2) _
& Sheet1.Cells(CurRow, 3) _
& Sheet1.Cells(CurRow, 4) _
& Sheet1.Cells(CurRow, 5), _
"#", vbTextCompare) Then
Else
Sheet1.Rows(CurRow & ":" & CurRow).Delete Shift:=xlUp
CurRow = CurRow - 1
End If
CurRow = CurRow + 1
Wend
End Sub
Using Instr, we concatenate the columns of interest (2-5 in my example code above) to create a single string of text. Then we search for # within that concatenated string and remove accordingly.
It changes
into
Alternatively, you can create an additional column containing the following formula:
FIND is used to identify whether an # exists within one of the preceding cells, print No if not and Yes if it does. Now you can filter these elements (No), select the range (making sure only the visible cells are selected), delete the rows and remove the filter.