1

I need to add a section within an existing macro that takes a cell's address and looks for that address (as a string?) from the values within a range of cells elsewhere on the sheet - then offsets one column over to use that cell's value to replace the original value of the cell who's address was searched.

My code is looking for unmerged cells, and when it finds an unmerged cell, it needs to grab the correct value to put in there. Not all cells in my range mCell are unmerged, so this is a find/replace within a loop.

I cannot hard code the cells, and also cannot figure out a functional loop that successfully moves through my range and finds/replaces using values from another part of the worksheet. I'm new at VBA and keep getting errors and wind up defining a dozen ranges and strings trying to carry over the data. Any help would be greatly appreciated!

For example:

if unmerged mCell.address = "B20", then the macro finds the value "B20" in a designated range (in example below, was found in cell Q20), then offset one column over (to cell R20), then uses value of that cell (which is 6) to replace the value of mcell, such that the new cell value of B20 (i.e., the active mCell) = 6. Then on to the next unmerged mCell...

 row   Column Q   Col. R '(not code, but can't get formatting any other way)
 18    B18(text)  5
 19    B19        4
 20    B20        6
 21    B21        3

Thank you for any suggestions, My existing code works great until "Part II", but then I'm failing miserably and am requesting specific help on how to correct/improve the code. Existing code is:

    ' This sub looks for the word "Table" in column A.  If the word appears, it unmerges the  cells in columns B - E
    ' and the rows following to allow for the insert of a table, then merges all other rows for sake of format.

Option Explicit
Private Sub Worksheet_Activate()

Application.ScreenUpdating = False

Range("B14:E64").SpecialCells(xlCellTypeVisible).Select
With Selection
.RowHeight = 17
.VerticalAlignment = xlTop
.HorizontalAlignment = xlLeft
.WrapText = True
End With

'*******Merge or unmerge rows according to whether or not they contain Table data -
' this only acts on visible cells, so rows of data table can be hidden as needed

 Dim TA As Integer
 Dim ColValues As Variant
 Dim rng As Range
 Dim tabNo As Range                    'uses value on worksheet to know how many rows to unmerge

'*******Dims in finding and replacing unmerged cell values

 Dim mergeRange As Range             'Range B16:E64 - where my mCells are being pulled from
 Dim mCell As Range                  'Cell that is unmerged, looking for its address
 Dim ws As Worksheet
 Dim tabledata As Range              'Range Q11:Q38 - this is the column I'm searching in and offsetting from
 Dim aCell As String                 'picks up cell address, to use in .find
 Dim myCell As Range                 'cell address in Q
 Dim ReplaceString As String
 Dim foundCell As Range
 Dim bCell As Range
 Dim i As Long

Application.DisplayAlerts = False

'Make column B = Column A values, cannot make this happen on sheet, because data is too variable

ColValues = ActiveSheet.Range("A16:A64").Value
ActiveSheet.Range("B16:B64").Value = ColValues

'Look for data table, if not present, merge cells
Set rng = ActiveSheet.Range("B14:B100")
Set tabNo = ActiveSheet.Range("K6")

For TA = 15 To 64                     'defines TA variable to loop from row 14 to row 64

If Cells(TA, "A") = "Table" Then      '

Range("B" & TA & ":E" & TA + tabNo).UnMerge   'unmerges the row with "Table" listed and the next 7 rows (to make a 8-row x 4 column unmerged area for table
TA = TA + tabNo                               ' moves active cell "TA" down 7 spaces


  Else

Range("B" & TA & ":E" & TA).Merge         'If "Table" not found, then merge the cells for the row TA is in across columns B:E
  End If

Next TA


'*** Part II: Need some calculation to loop or offset or find through data and fill
'unmerged cells from a data table on the worksheet.
'the placement of the data table varies depending on the layout of the report,
'which changes day to day, so can not be hard coded into the cells - needs to look up
'position of the word "Table" and dump data after that.

'offset? .find? loop?


'***want to take the cell address of each unmerged cell within the range of the report
'and look for that cell in an array, then replace the cell contents with the correct value


Set mergeRange = ActiveSheet.Range("B16:E64")

For Each mCell In mergeRange
   ' If mergeRange.MergeCells = True Then
   ' MsgBox "all cells are merged, exiting sub"
   ' Exit Sub
   'Else
    If mCell.MergeCells = False Then

   aCell = mCell.Address      '??? Need to set the cell address as
                                    'a text string or something in order to look for that address in the values
                                  'of cells in range "tabledata"

    'MsgBox "aCell " & Range(aCell).Address


    Set tabledata = ActiveSheet.Range("Q11:Q38")

    Set bCell = tabledata.Find(aCell, After:=Range("Q1"), LookIn:=xlValues, lookAt:=xlWhole,  SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

                                    'this gives me a "type mismatch" error that I cannot clear


                                    '- then wanting the value of the cell offset one column over
                                    'need to take the value of that offset cell and use it
                                    'to replace the value of the original unmerged cell (mCell)

    ActiveCell.Offset(1, 0).Select
    ActiveCell.Offset(0, 1).Value = ActiveCell.Value



  Application.DisplayAlerts = True


  Application.ScreenUpdating = True

  End If
  Next mCell

  End Sub
3
  • There are a lot of questions in there. It might be an idea to break this up into several smaller questions. Commented Oct 16, 2012 at 20:29
  • Jamie, it is a long post, but my main goal is a good loop. I think I am not carrying over the cell's address correctly in my "aCell", and cannot get past my .Find statement. I have tried coding myself, and did not get very far. My excel file is on Dropbox should anyone want to see how it works: dl.dropbox.com/u/39896969/Test%20Workbook%201016.xlsm Commented Oct 16, 2012 at 20:43
  • You were actually very close. See my answer below if you haven't already. Commented Oct 17, 2012 at 10:04

1 Answer 1

0

There were a few problems in there but I think it's working now. You'll have to verify as I'm still not 100% sure what it is supposed to do.

Problem 1: You don't need tabledata. You specify in the search parameters After:=Range("Q1") so it's looking in the right place. Find works on a Cells so your line should be:

Set bCell = Cells.Find(aCell, After:=Range("Q1"), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

Problem 2: Your line aCell = mCell.Address needs to be aCell = Replace(mCell.Address, "$", "") as it comes in as an absolute cell reference and the cell address on your sheet are not (probably a more elegant way of doing this).

There were a couple of other problems in your Dropbox file but those should be sorted too now. There was an extra Next and the line aCell.Offset(, 1) = bCell.Offset(, 1) seems like it should be mCell.Offset(, 1) = bCell.Offset(, 1).

https://www.dropbox.com/s/jqdg3v0gd59mxjn/Test%20Workbook%201016jb.xlsm

Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.