Project

K

kabali

Banned User
Joined
Nov 30, 2022
Messages
33
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have an excel workbook with multiple worksheets that are exported from a different folder. I have created a sheet called "DestinationSheet" to display the outputs then "NewSheet" where all my command buttons are. I want to do the some adjustments to the following VBA codes that were already run through macro. I need the columns C and D corresponding to each exactly in the B columns.

Following the VBA code for each column C and D that are needed to adjust
Figure1:
1671989312952.png



1)
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "DestinationSheet" Then
ws.Range("C14").Copy Sheets("DestinationSheet").Cells(Rows.Count, "B").End(xlUp).Offset(1)
End If
Next
Application.ScreenUpdating = True

End Sub

This is for column B as shown in the screenshot. I need to bring it down 3 rows from the top.

2) Sub NonCashField()

'(SUM('Sheet1'!D23:Q23) > 0
With Worksheets("DestinationSheet")

For i = 1 To Worksheets.Count
nm = Worksheets(i).Name
.Range(.Cells(i + 1, 3), .Cells(i + 1, 3)).Formula = "=SUM('" & nm & "'!D23:q23) > 0"

Next i
End With

End Sub

This is for column C. I need to bring it down 3 rows from the top.

3)
Dim sh As Worksheet, shd As Worksheet
Dim i As Long

i = 2
Set shd = Sheets("DestinationSheet")
For Each sh In Sheets
If sh.Name <> shd.Name Then
If sh.Range("Q13").Value = "2" And sh.Range("Q15").Value = "2" Then
shd.Range("D" & i).Value = "Not met"
Else
shd.Range("D" & i).Value = "Met"

End If
i = i + 1

End If
Next
End Sub

This is for the output for column D as shown screenshot. It needs to bring output from 3 rows down from the top

The final output should be like this:
Figure2:
1671990084219.png



When I ran the Macro, it grabs the values from "NewSheet" and "DestinationSheet". I want to grab the values from other sheets excluding the "NewSheet" and "DestinationSheet" in the

I would really appreciate it if you could help me fix for each columns and should be similar to the one in Figure 2
 

Attachments

  • 1671988786059.png
    1671988786059.png
    45.3 KB · Views: 6
  • 1671989288477.png
    1671989288477.png
    18.8 KB · Views: 6

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
Hi kabali,

maybe

VBA Code: 
Public Sub MrE_1225429_1616715()
' https://www.mrexcel.com/board/threads/project.1225429/

Dim ws As Worksheet
Dim wsTarg As Worksheet
Dim lngWrite As Long

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
wsTarg.Cells.ClearContents
Application.ScreenUpdating = False
With wsTarg
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> .Name And ws.Name <> "NewSheet" Then
      lngWrite = WorksheetFunction.Max(.Cells(Rows.Count, "B").End(xlUp).Row + 1, 3)
      ws.Range("C14").Copy .Cells(lngWrite, "B")
      .Cells(lngWrite, 3).Formula = "=SUM('" & ws.Name & "'!D23:q23) > 0"
      .Range("D" & lngWrite).Value = IIf((ws.Range("Q13").Value = "2" And ws.Range("Q15").Value = "2"), "Not met", "Met")
    End If
  Next ws
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

although from the code posted as well as the pictures I miss the names of the worksheets (if it's not what is pasted in Column C).

Ciao,
Holger
 
Upvote 0
Solution
HaHoBe said:
Hi kabali,

maybe

VBA Code: 
Public Sub MrE_1225429_1616715()
' https://www.mrexcel.com/board/threads/project.1225429/

Dim ws As Worksheet
Dim wsTarg As Worksheet
Dim lngWrite As Long

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
wsTarg.Cells.ClearContents
Application.ScreenUpdating = False
With wsTarg
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> .Name And ws.Name <> "NewSheet" Then
      lngWrite = WorksheetFunction.Max(.Cells(Rows.Count, "B").End(xlUp).Row + 1, 3)
      ws.Range("C14").Copy .Cells(lngWrite, "B")
      .Cells(lngWrite, 3).Formula = "=SUM('" & ws.Name & "'!D23:q23) > 0"
      .Range("D" & lngWrite).Value = IIf((ws.Range("Q13").Value = "2" And ws.Range("Q15").Value = "2"), "Not met", "Met")
    End If
  Next ws
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

although from the code posted as well as the pictures I miss the names of the worksheets (if it's not what is pasted in Column C).

Ciao,
Holger
Click to expand...

Hi,

Actually I want the VBA codes to be separately for 1) , 2) and 3) but not altogether by excluding the worksheets, "NewSheets" and "DestinationSheet"
 
Upvote 0
Hi kabali,

although I can't see the advantage of having three macros instead of one - I set up DestinationSheet to meet my criteria for ease of use:

VBA Code: 
Public Sub MrE_1225429_1616715_01()
' https://www.mrexcel.com/board/threads/project.1225429/
' Updated: 20221225
' Reason:  user insists on using three different macros, setting up sheet to meet criteria

' setting up the headers for the data inserted
' copying over worksheet names and content of cell C14

Dim ws As Worksheet
Dim wsTarg As Worksheet
Dim lngWrite As Long

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
wsTarg.Cells.ClearContents
With wsTarg.Range("B2:E2")
  .Value = Array("Sheetname", "Value C14", "SUM", "State Criteria")
  .Font.Size = 12
  .Font.Bold = True
End With
Application.ScreenUpdating = False
With wsTarg
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> .Name And ws.Name <> "NewSheet" Then
      lngWrite = .Cells(Rows.Count, "c").End(xlUp).Row + 1
      .Cells(lngWrite, "B").Value = ws.Name
      .Cells(lngWrite, "C").Value = ws.Range("C14").Value
    End If
  Next ws
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

VBA Code: 
Public Sub MrE_1225429_1616715_02()
' https://www.mrexcel.com/board/threads/project.1225429/
' Updated: 20221225

' working only when sheetnames are listed in Column B
' insert formula for sum

Dim wsTarg As Worksheet
Dim rngCell As Range

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
Application.ScreenUpdating = False
With wsTarg
  For Each rngCell In .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    If Evaluate("ISREF('" & rngCell.Value & "'!A1)") Then
      rngCell.Offset(0, 2).Formula = "=SUM('" & rngCell.Value & "'!D23:q23) > 0"
    End If
  Next rngCell
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

VBA Code: 
Public Sub MrE_1225429_1616715_03()
' https://www.mrexcel.com/board/threads/project.1225429/
' Updated: 20221225

' working only when sheetnames are listed in Column B
' insert check for criteria

Dim wsTarg As Worksheet
Dim rngCell As Range

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
Application.ScreenUpdating = False
With wsTarg
  For Each rngCell In .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    If Evaluate("ISREF('" & rngCell.Value & "'!A1)") Then
      rngCell.Offset(0, 3).Value = IIf((Worksheets(rngCell.Value).Range("Q13").Value = "2" And Worksheets(rngCell.Value).Range("Q15").Value = "2"), "Not met", "Met")
    End If
  Next rngCell
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

Ciao,
Hiolger
 
Upvote 0
HaHoBe said:
Hi kabali,

although I can't see the advantage of having three macros instead of one - I set up DestinationSheet to meet my criteria for ease of use:

VBA Code: 
Public Sub MrE_1225429_1616715_01()
' https://www.mrexcel.com/board/threads/project.1225429/
' Updated: 20221225
' Reason:  user insists on using three different macros, setting up sheet to meet criteria

' setting up the headers for the data inserted
' copying over worksheet names and content of cell C14

Dim ws As Worksheet
Dim wsTarg As Worksheet
Dim lngWrite As Long

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
wsTarg.Cells.ClearContents
With wsTarg.Range("B2:E2")
  .Value = Array("Sheetname", "Value C14", "SUM", "State Criteria")
  .Font.Size = 12
  .Font.Bold = True
End With
Application.ScreenUpdating = False
With wsTarg
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> .Name And ws.Name <> "NewSheet" Then
      lngWrite = .Cells(Rows.Count, "c").End(xlUp).Row + 1
      .Cells(lngWrite, "B").Value = ws.Name
      .Cells(lngWrite, "C").Value = ws.Range("C14").Value
    End If
  Next ws
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

VBA Code: 
Public Sub MrE_1225429_1616715_02()
' https://www.mrexcel.com/board/threads/project.1225429/
' Updated: 20221225

' working only when sheetnames are listed in Column B
' insert formula for sum

Dim wsTarg As Worksheet
Dim rngCell As Range

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
Application.ScreenUpdating = False
With wsTarg
  For Each rngCell In .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    If Evaluate("ISREF('" & rngCell.Value & "'!A1)") Then
      rngCell.Offset(0, 2).Formula = "=SUM('" & rngCell.Value & "'!D23:q23) > 0"
    End If
  Next rngCell
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

VBA Code: 
Public Sub MrE_1225429_1616715_03()
' https://www.mrexcel.com/board/threads/project.1225429/
' Updated: 20221225

' working only when sheetnames are listed in Column B
' insert check for criteria

Dim wsTarg As Worksheet
Dim rngCell As Range

Set wsTarg = ActiveWorkbook.Worksheets("DestinationSheet")
Application.ScreenUpdating = False
With wsTarg
  For Each rngCell In .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    If Evaluate("ISREF('" & rngCell.Value & "'!A1)") Then
      rngCell.Offset(0, 3).Value = IIf((Worksheets(rngCell.Value).Range("Q13").Value = "2" And Worksheets(rngCell.Value).Range("Q15").Value = "2"), "Not met", "Met")
    End If
  Next rngCell
End With
Application.ScreenUpdating = True
Set wsTarg = Nothing
End Sub

Ciao,
Hiolger
Click to expand...
so, if I run each macros, so it will populate the outcome similar to the screenshot below right?

1672005774896.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
139
Akuini
Akuini
GimpyHand
  • Question
Duplicate Copy/Paste in VBA issue
Replies
3
Views
331
Joe4
Joe4
B
  • Question
Update =getimage() inbetween VBA prints
Replies
0
Views
120
Bajjonetaz
B
J
  • Question
Consolidate data from multiple sheets based on values selected in dependent list boxes
Replies
0
Views
214
jconda
J
K
  • Locked
  • Question
VBA code creation
Replies
1
Views
224
Fluff
Fluff

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,094
Latest member
teemeren

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top