0
votes

I am using Excel and am looking to get the name of the table based on a cell address (ex A3), this cell will not move. How would I go about stating this in Excel's VBA?

My plan is to have code that will copy data validations from a row of one table on my Maintenance tab to a single table on each tab of my workbook (minus my "TOC" and "data" tabs). Each tab is a copy of a "TEMPLATE" worksheet (minus the "TOC", "data", & the "TEMPLATE (Maint.)" worksheets). Worksheets "data", "TEMPLATE", and "TEMPLATE (Maint.)" may or may not be hidden.

Edit: I would like to go about doing this by:

  1. Copy data validations on the "TEMPLATE (Maint.)" worksheet
  2. Check C3 on target worksheet and find what table it is apart of; cell C3 being the upper left most cell in the able, it is a header
  3. Copy the data validations to each of the data rows of the table found in step 2.
  4. Repeat steps 2 and 3 until all worksheets have had the validations copied to (minus the "TOC", "data", & the "TEMPLATE (Maint.)" worksheets).

The code I have in my "Copy_Data_Validations" sub is as follows:

Dim TotalSheets As Integer
Dim p As Integer
Dim iAnswer As VbMsgBoxResult

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'
' Move sheet "TOC" to the begining of the workbook.
'
Sheets("TOC").Move Before:=Sheets(1)
'
' Move sheet "data" to be the second sheet in the workbook.
'
Sheets("data").Move Before:=Sheets(2)

iAnswer = MsgBox("You are about to copy data validations!", vbOKCancel + vbExclamation _
+ vbDefaultButton2 + vbMsgBoxSetForeground, "Copying Data Valadations")
For TotalSheets = 1 To Sheets.Count
    For p = 3 To Sheets.Count - 2
'
' If the answer is Yes, then copy data validations from "TEMPLATE (Maint.) to all other.
' sheets minus the "TOC" sheet and the "data" sheet.
'
        If iAnswer = vbYes Then
            If UCase$(Sheets(p).Name) <> "TOC" And UCase$(Sheets(p).Name) <> "data" Then

                ' This chunk of code should copy only the data validations
                ' of "Table1_1" (A4:AO4) from the maintenance tab to all
                ' rows of a single table on each worksheet (minus the
                ' "TOC", "data", & the "TEMPLATE (Maint.)" worksheets.
                ' This is the section of code I am looking for unless
                ' someone has something better they can come up with.

                Selection.PasteSpecial Paste:=xlPasteValidation, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
'
' If the answer is Cancel, then cancels.
'
        ElseIf iAnswer = vbCancel Then
        ' Add an exit here.
        End If

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
1
You can cycle through all worksheets with a loop: For Each ws in ThisWorkbook.Worksheets. Here is a good example that might serve you as a helping point: stackoverflow.com/questions/21918166/…Ralph
Thank you @Ralph , I'll start by giving this a try.David S.
Edit: I have updated my code to reflect my progress but as you can see I am still missing some logic (and possibly some syntax too). Any help to complete this macro would be appreciated.David S.
Accidentally ended up creating a duplicate post when I added more and more information to the other post. This post has now been updated with the latest information as to what I am looking for help with.David S.
What's wrong with the solution provided by @saksham-gupta? Isn't it working? Of course it is now out of line with you changing the starting point and will require some adjustments. But other than that you should give it a go and possibly accept it as an answer if it works.Ralph

1 Answers

3
votes
Sub test()

Dim ws As Worksheet

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "TOI" And ws.Name <> "DATA" And ws.Name <> "TEMPLATE (Maint.)" Then
        Sheets("TEMPLATE (Maint.)").Select
        Range("Table1").Select
        Selection.Copy
        ws.Select
        Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End If
Next
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub