VBA Excel - Offset with merged cells - excel

Yes, you maybe think, why the hell did he even use merged cells. Let me explain:
We receive the insurance periods from our insured persons from various companies around the world in Excel format. I have to read this data automatically, but I have the problem that these Excel files contain merged cells. These are always merged differently. However, what is always the same is that the next cells to the right of the starting cell contain the desired information. So I would need a code to always determine the data to the right of the starting cell, but considered that they are merged cells. Can .offset do this?
Example:
A5:C5 merged, D5 not merged, E5:H5 merged, I5:P5 merged
--> I need the data from D5, E5 and I5 (cells to the right of it)
For the next insured, the same data is formatted as follows:
A5:B5 merged, C5:F5 merged, G5:J5 merged, K5:O5 merged
--> I need the data from C5, G5 and K5 (cells to the right of it)
So it's always the 3 cells to the right of it, but right in terms of merged cells.
Can someone help me? Thanks!
Update: This is what i tried, from start c is AN87 and the NewAddress gives me AM87 even though AK87:AM87 is merged.
Dim c As Range
Dim firstAddress As String
With Workbooks(Left(myworksheet.Range("E10").Value, Len(myworksheet.Range("E10").Value) - 4) & ".xlsx").Worksheets("Sheet1").Range("A1:AY1000")
Set c = .Find(myworksheet.Range("E11").Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
ElzPeter = c.Address
MsgBox ElzPeter
End If
End With
Dim MA As Range, NewAddress As String
Set MA = c.MergeArea
NewAddress = MA.Offset(, -1).Resize(MA.Rows.Count).Address
MsgBox NewAddress

If you have a merged cell, .Offset(0, 1) will always give you the first cell to the right of the merged area. So if cells "A5:C5" are merged, Range("A5").Offset(0, 1) will give you "D5".
Assuming that you start at "A5", the following should do the trick for you:
With ActiveSheet ' Specify the sheet you want to work with
Set r = .Range("A5")
For i = 1 To 3
Set r = r.Offset(0, 1)
Debug.Print r.Address, r.MergeArea.Address, r.Value
Next
End With
Update
If you want to go from right to left: Offset(0, -1) will give you the last cell of the merged area. From there, you can get the value of the merged cells with MergeArea.Cells(1, 1)
Set r = .Range("AN87")
For i = 1 To 3
Set r = r.Offset(0, -1)
Debug.Print r.Address, r.MergeArea.Address, r.MergeArea.Cells(1, 1).Value
Next

Related

concatenate cells (using variables in a loop) and keep the fill colour in VBA

I have an excel file that looks like:
So I have those matrixes in the sheet (lets say this is Sheet1). I have a lot of similar sheets.
I need to arrive at a result in another sheet, result that look like that:
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
.
.
.
4599
So I need to concatenate the cells in order to come at the above results.
In my example, lets say that the number "45" is on the merged cells A1,B1,C1,D1,E1,F1,G1,H1,I1,J1.
In that matrix, with the header "45":
"00" will be on A2,
"01" will be on B2 and so on.
The concatenate it's simple. (or not...)
I made a new sheet (Sheet2), made a command button and put this code:
Range("A1").Value = Worksheets("Sheet1").Range("A1") & Worksheets("Sheet1").Range("A2")
Range("A2").Value = Worksheets("Sheet1").Range("A1") & Worksheets("Sheet1").Range("B2")
and so on, which works, but i would like something with variables...
But i am new to VBA and a don't quite understand how i can do this in order to not write hundreds of lines of code...
The other (big) problem is that i need to keep the colour of the last cell which participates at the concatenation.
Examples:
For "4500" the colour in the results sheet must be blue.
For "4555" the colour in the results sheet must be white.
For "4580" the colour in the results sheet must be yellow.
So i need to keep the exact index colour.
I need to do those concatenations and to keep the colour for every matrix.
I can't figure out how to maintain the colour.. I used something with Interior.ColorIndex but i put this manually after the concatenation.. which doesn't work for my case, because this excel file is very big.
I think I need to make a loop and to concatenate and in the same time keep the colour.
I'm newbie in VBA but i find this very interesting. Any help is very appreciated. Thank you in advance!
A rough outline for looping over a block:
Dim rng As Range, c As Range, cDest As Range, hdr
Set cDest = ThisWorkbook.Sheets("Data").Range("a2")
Set rng = ActiveSheet.Range("B2:K11")
hdr = rng.Cells(1).Offset(-1, 0).Value 'header
For Each c In rng.Cells
With cDest
.Value = hdr & c.Text
.Interior.Color = c.Interior.Color
End With
Set cDest = cDest.Offset(1, 0)
Next c

Return cells content from range

Yesterday I learned here how to copy a row to a second sheet.
Sub maJolieProcedure(Texte As String)
With Worksheets("employes").Range("A:A")
Set c = .Find(what:=Texte)
If Not c Is Nothing Then
firstAddress = c.Row
Worksheets("employes").Rows(firstAddress).Copy _
Destination:=Worksheets("rapport").Range("A1")
MsgBox "Ok"
Else
MsgBox "Nok"
End If
End With
End Sub
To respect the formatting of the second sheet, I want to copy and paste the contents of each cell one by one.
I can identify the line number. However, I can't figure out how the Range object can return each cell one by one. For example, C3 content if Rows = 3.
Thanks a lot.
If you don't want to paste the formatting from one range to another paste values only.
Worksheets("employes").Rows(firstAddress).Copy
Worksheets("rapport").Range("A1").PasteSpecial xlValues
That's the same for all ranges, whether 1 cell or a million. The Copy process copies the subject to memory as one block. Any parsing must be done before the Copy instruction. An alternative is to read a range into an array.
Dim Arr As Variant
Arr = Worksheets("employes").Rows(firstAddress).Value
This will create a 3D array of 1 row and about 16000 columns. You might decide to limit your enthusiasm to only what you need.
With Worksheets("employees")
Arr = .Range(.Cells(firstAddress, 1), .Cells(firstAddress, .Columns.Count).End)xlToLeft)).Value
End With
Pay attention to the leading periods within the With statement. Each such period stands for the object mentioned in the With statement.
If your goal is to respect the formating of the second sheet, you don't need to loose time copying cell by cell.
It is more effective to do a paste special, like you do with the mouse:
Range("A1").Copy
Range("B1").PasteSpecial Paste:=xlPasteValues
works very well also with bigger ranges if you need:
Range("A1:A12").Copy
Range("B1:B12").PasteSpecial Paste:=xlPasteValues
or even
Range("A1:A12").Copy
Range("D3").PasteSpecial Paste:=xlPasteValues
If your goal is to really access all cell of a range individually , you just iterate on the range. For example:
For Each cell In Range("A1:A12")
cell.Value = cell.Value + 2
Next cell

How do I clear content in rows based on cell value?

I copy a lot of information (1000 rows and at least 24 columns) from one sheet to another. A lot of the cells contains "". This makes my other formulas(for example: A1-B1) to show an value error if either of these cells contains "".
I believe I can solve the problem by never pasting "" but a "0" instead. But I would like to delete these "0" afterwards.
There could be values in the first 3 rows but the other 997 rows have "".
I would think I need to tell my macro to (Cell A1 in the "sheet1" sheet displays "G5:H12". the cells I need to delete):
Rowstodelete = Sheets("sheet1").Range("A1").Value
Sheets("sheet1").Range("rowstodelete").clearcontent
This does not work. anyone know how to do this?
Summary(new example)
If cell A1 = "B1:B2" I want to clear the content of B1 and B2, but if A1 now = B4:B6, that is the cells that should be cleared.
Try this one:
With Worksheets(1).Range( _'PLACE YOUR RANGE
)
Set c = .Find(0, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = ""
Set c = .FindNext(c)
Loop While Not c Is Nothing
End If
End With
Hope it helps
Anyhow, I think that will be simpler to place a condition in your operation formula: =IF(OR(A1="",B1=""),Make when there is an unexpected value,A1-B1)

Find specifc text in multiple columns in excel

I've got a formula that's been puzzling me for a while - I feel I'm close but the solution is evading me so I'm turning to you wizards. This questions is similar to Excel VLOOKUP and SEARCH combination.
Problem:
I want to look up a value which is a pair of codes separated by a dash, ex.
01-05
A1-B2
AB-90
, within columns A and B and return a result from C.
The issue is that I'm searching in two columns, which may include multiple codes separated by commas:
Col A Col B Col C
01 05, B2 Result1
A1 B2 Result2
AB, AC 90, 91, 92 Result3
I was thinking that a =if(isnumber(search( function would be the key but I can't figure how to have it check the entire column and once found, check the column next to it for the 2nd part of the code.
Ideally, the formula would perform as such, where in the above example, if I were to run this formula on the criteria 01-05 it would return Result1.
Appreciated!
the "formula" approach is, to my knowledge, quite verbose and cumbersome as follows:
=IF(
ISNA(
IFERROR(MATCH(LEFT(D1,SEARCH("-",D1)-1),Codes!$A$1:$A$100,0),
IFERROR(MATCH("*"&LEFT(D1,SEARCH("-",D1)-1)&",*",Codes!$A$1:$A$100,0),
MATCH("*,"&LEFT(D1,SEARCH("-",D1)-1)&"*",Codes!$A$1:$A$100,0)))
*
IFERROR(MATCH(RIGHT(D1,LEN(D1)-SEARCH("-",D1)),Codes!$B$1:$B$100,0),
IFERROR(MATCH("*"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&",*",Codes!$B$1:$B$100,0),
MATCH("*,"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&"*",Codes!$B$1:$B$100,0)))
),
"Not Found",
IF(IFERROR(MATCH(LEFT(D1,SEARCH("-",D1)-1),Codes!$A$1:$A$100,0),
IFERROR(MATCH("*"&LEFT(D1,SEARCH("-",D1)-1)&",*",Codes!$A$1:$A$100,0),
MATCH("*,"&LEFT(D1,SEARCH("-",D1)-1)&"*",Codes!$A$1:$A$100,0)))
<>
IFERROR(MATCH(RIGHT(D1,LEN(D1)-SEARCH("-",D1)),Codes!$B$1:$B$100,0),
IFERROR(MATCH("*"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&",*",Codes!$B$1:$B$100,0),
MATCH("*,"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&"*",Codes!$B$1:$B$100,0))),
"Different rows",
INDEX(Codes!C:C,IFERROR(MATCH(RIGHT(D1,LEN(D1)-SEARCH("-",D1)),Codes!$B$1:$B$100,0),
IFERROR(MATCH("*"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&",*",Codes!$B$1:$B$100,0),
MATCH("*,"&RIGHT(D1,LEN(D1)-SEARCH("-",D1))&"*",Codes!$B$1:$B$100,0))))
)
)
where I used a (hopefully) more readable format and assumed:
"Codes" as the sheet name whose columns "A" ("first" code), "B" ("second" code) and "C" ("Results") are placed
codes pairs are to be placed in column "D" of any sheet
formula is to be placed in column "E" adjacent to above mentioned column "D" cells
you may want to consider a "VBA" approach like the following
Sub main()
Dim codesSht As Worksheet
Dim cell As Range, found As Range, codesRng As Range
Dim index1 As Long
Set codesSht = ThisWorkbook.Worksheets("Codes") '<== change "codes" sheet reference as per your needs
Set codesRng = codesSht.Range("A:B").SpecialCells(xlCellTypeConstants, xlTextValues)
With ThisWorkbook.Worksheets("Results") '<== change "Results" sheet reference as per your needs
For Each cell In .Range("D1:D" & .Cells(.Rows.count, "D").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
Set found = codesRng.Resize(, 1).Find(What:=Split(cell.Value, "-")(0), LookIn:=xlValues, LookAt:=xlPart)
If Not found Is Nothing Then
index1 = found.Row
Set found = codesRng.Offset(, 1).Resize(, 1).Find(What:=Split(cell.Value, "-")(1), LookIn:=xlValues, LookAt:=xlPart)
If Not found Is Nothing Then If found.Row = index1 Then cell.Offset(, 1).Value = codesRng(index1, 3)
End If
Next cell
End With
End Sub
If you put the code you are looking for in Column D, then your formula in Column E, the following formula will accomplish what you are looking for ...
=IF(OR(ISERROR(FIND(LEFT(D2,2),A2)),ISERROR(FIND(RIGHT(D2,2),B2)),LEN(D2)=0),"",C2)
And then fill it down.
The formula searches for the left two characters from the code in Column A. If it's not found, an error is thrown. It also looks for the right two characters from the code in Column B. If it's not found, an error is thrown. If the code you are looking for is blank, no error is thrown, so we need to check that case.
So if there is an error searching for the left part, or an error searching for the right part, or there is no code to look for, return a blank. Otherwise, return the result.
Below are some examples ...
Updated based on comments
On Sheet1, the data looks like this ...
... On Sheet2, we have results like this ...
Where Cell B2 contains this formula (filled down)
{=CONCAT(IF(ISERROR(FIND(LEFT(A2,2),Sheet1!$A$1:$A$3)),"",IF(ISERROR(FIND(RIGHT(A2,2),Sheet1!$B$1:$B$3)),"",IF(LEN(A2)<1,"",Sheet1!$C$1:$C$3))))}
Updated due to version-itis
When all else fails, go to VBA. Attached is an example Function. It gets the same results as shown above. It is invoked with formula in Column B, filled down ...
=FindResult(A2,Sheet1!$A$1:$A$3,Sheet1!$B$1:$B$3,Sheet1!$C$1:$C$3)
Code ...
Function FindResult(inString As String, LeftRange As Range, RightRange As Range, ReturnRange As Range) As String
Dim strArr() As String
Dim myCellLeft As Range, myCellRight
'initial
FindResult = ""
If LeftRange Is Nothing Then GoTo Done:
If RightRange Is Nothing Then GoTo Done:
If ReturnRange Is Nothing Then GoTo Done:
' get the two halfs
strArr = Split(inString, "-")
If UBound(strArr) < 1 Then GoTo Done:
' Search the left range for the left half, the right range for the right half
For Each myCellLeft In LeftRange
If InStr(1, myCellLeft.Value, strArr(0)) > 0 Then
For Each myCellRight In RightRange.Rows(myCellLeft.Row)
If InStr(1, myCellRight.Value, strArr(1)) > 0 Then
FindResult = ReturnRange.Rows(myCellLeft.Row)
Exit For
End If
Next myCellRight
If FindResult <> "" Then Exit For
End If
Next myCellLeft
' clean up
Done:
Erase strArr
Set myCellLeft = Nothing
Set myCellRight = Nothing
End Function

Excel compare two columns and highlight duplicates

I have an excel file with 10,000 rows in column A some values are the same.
Example:
A1 - P7767
A2 - P3443
A3 - P7767
A4 - P8746
A5 - P9435
etc...
I then have another column with 100 rows which have some of the values found in column A,
B1 - P7767
B2 - P8746
etc...
I need to highlight all cells in column A where the value is found in any of the values in column B
So basically column B checks to see if it can find the same value anywhere in column A, if true highlight the cell leaving any cells white when the value is not found in column B
I hope I have explained this well, I have done some research and I believe I need to use conditional formatting to get this result but I am really stuck on the formula to use and cannot seem to find an example online (Maybe I am not searching the correct term as I'm not sure on what this is exactly called)
There may be a simpler option, but you can use VLOOKUP to check if a value appears in a list (and VLOOKUP is a powerful formula to get to grips with anyway).
So for A1, you can set a conditional format using the following formula:
=NOT(ISNA(VLOOKUP(A1,$B:$B,1,FALSE)))
Copy and Paste Special > Formats to copy that conditional format to the other cells in column A.
What the above formula is doing:
VLOOKUP is looking up the value of Cell A1 (first parameter) against the whole of column B ($B:$B), in the first column (that's the 3rd parameter, redundant here, but typically VLOOKUP looks up a table rather than a column). The last parameter, FALSE, specifies that the match must be exact rather than just the closest match.
VLOOKUP will return #ISNA if no match is found, so the NOT(ISNA(...)) returns true for all cells which have a match in column B.
A simple formula to use is
=COUNTIF($B:$B,A1)
Formula specified is for cell A1. Simply copy and paste special - format to the whole of column A
NOTE: You may want to remove duplicate items (eg duplicate entries in the same column) before doing these steps to prevent false positives.
Select both columns
click Conditional Formatting
click Highlight Cells Rules
click Duplicate Values (the defaults should be OK)
Duplicates are now highlighted in red:
The easiest way to do it, at least for me, is:
Conditional format-> Add new rule->Set your own formula:
=ISNA(MATCH(A2;$B:$B;0))
Where A2 is the first element in column A to be compared and B is the column where A's element will be searched.
Once you have set the formula and picked the format, apply this rule to all elements in the column.
Hope this helps
A1 --> conditional formatting --> cell value is B1 --> format: whatever you want
hope that helps
Suppose you want to compare a column A and column H in a same spreadsheet .
You need to go another column next to these 2 columns and paste this formula :
=(Sheet1!A:A=Sheet1!H:H)
this will display FALSE or TRUE in the column . So you can use this new column to color the non matching values using conditional color formatting feature .
I was trying to compare A-B columns and highlight equal text, but usinng the obove fomrulas some text did not match at all. So I used form (VBA macro to compare two columns and color highlight cell differences) codes and I modified few things to adapt it to my application and find any desired column (just by clicking it). In my case, I use large and different numbers of rows on each column. Hope this helps:
Sub ABTextCompare()
Dim Report As Worksheet
Dim i, j, colNum, vMatch As Integer
Dim lastRowA, lastRowB, lastRow, lastColumn As Integer
Dim ColumnUsage As String
Dim colA, colB, colC As String
Dim A, B, C As Variant
Set Report = Excel.ActiveSheet
vMatch = 1
'Select A and B Columns to compare
On Error Resume Next
Set A = Application.InputBox(Prompt:="Select column to compare", Title:="Column A", Type:=8)
If A Is Nothing Then Exit Sub
colA = Split(A(1).Address(1, 0), "$")(0)
Set B = Application.InputBox(Prompt:="Select column being searched", Title:="Column B", Type:=8)
If A Is Nothing Then Exit Sub
colB = Split(B(1).Address(1, 0), "$")(0)
'Select Column to show results
Set C = Application.InputBox("Select column to show results", "Results", Type:=8)
If C Is Nothing Then Exit Sub
colC = Split(C(1).Address(1, 0), "$")(0)
'Get Last Row
lastRowA = Report.Cells.Find("", Range(colA & 1), xlFormulas, xlByRows, xlPrevious).Row - 1 ' Last row in column A
lastRowB = Report.Cells.Find("", Range(colB & 1), xlFormulas, xlByRows, xlPrevious).Row - 1 ' Last row in column B
Application.ScreenUpdating = False
'***************************************************
For i = 2 To lastRowA
For j = 2 To lastRowB
If Report.Cells(i, A.Column).Value <> "" Then
If InStr(1, Report.Cells(j, B.Column).Value, Report.Cells(i, A.Column).Value, vbTextCompare) > 0 Then
vMatch = vMatch + 1
Report.Cells(i, A.Column).Interior.ColorIndex = 35 'Light green background
Range(colC & 1).Value = "Items Found"
Report.Cells(i, A.Column).Copy Destination:=Range(colC & vMatch)
Exit For
Else
'Do Nothing
End If
End If
Next j
Next i
If vMatch = 1 Then
MsgBox Prompt:="No Itmes Found", Buttons:=vbInformation
End If
'***************************************************
Application.ScreenUpdating = True
End Sub
Don't wana do soo much work guyss..
Just Press Ctr and select Colum one and Press Ctr and select colum two.
Then click conditional formatting -> Highlight Cell Rules -> Equel To.
and thats it. your done. :)

Resources