Johnny Thunder
Well-known Member
- Joined
- Apr 9, 2010
- Messages
- 693
- Office Version
- 2016
- Platform
- MacOS
Hello all,
I am working on a project and I have gotten fairly far with this and needed some guidance and possibly some revisions to my code to make it faster and shorter.
Objective:
1. I have a Master Data Sheet (Ws2) that has 17 rows of data Columns("B:O"). Thru a loop on Column B, if the value is "Backlog" then define all the attributes in that row with various Strings.
2. On my second Sheet (Ws1) I am creating a grid 2 Columns Wide, x amount of rows (based on how many values are on (Ws2), there is 1 blank row in between every cell of Data.
Problem:
I have the code able to populate all the details in each cell, I am running into an issue because I only want to have 14 Populated Cells per Column and I have two columns to work with. So what I was trying to do is have the For Each Loop stop at the 14th pasted text, and then move back up to the start (H7) and shift over 4 columns and continue pasting the text strings.
I feel like I was doing a weird roundabout way of defining when to stop by getting to row 35 with the loop and trying to manually shift back up to H7 and then shift over to the next column.
Any help is appreciated, I feel like this could probably be done faster/smarter with a "For i = 1 to 33" Kinda loop instead but I am not saavy with that code.
Here is the code:
I am working on a project and I have gotten fairly far with this and needed some guidance and possibly some revisions to my code to make it faster and shorter.
Objective:
1. I have a Master Data Sheet (Ws2) that has 17 rows of data Columns("B:O"). Thru a loop on Column B, if the value is "Backlog" then define all the attributes in that row with various Strings.
2. On my second Sheet (Ws1) I am creating a grid 2 Columns Wide, x amount of rows (based on how many values are on (Ws2), there is 1 blank row in between every cell of Data.
Problem:
I have the code able to populate all the details in each cell, I am running into an issue because I only want to have 14 Populated Cells per Column and I have two columns to work with. So what I was trying to do is have the For Each Loop stop at the 14th pasted text, and then move back up to the start (H7) and shift over 4 columns and continue pasting the text strings.
I feel like I was doing a weird roundabout way of defining when to stop by getting to row 35 with the loop and trying to manually shift back up to H7 and then shift over to the next column.
Any help is appreciated, I feel like this could probably be done faster/smarter with a "For i = 1 to 33" Kinda loop instead but I am not saavy with that code.
Here is the code:
Code:
Sub DramaTest()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim CurrCell As Range
Dim LastR As Long, LastR2 As Long
Dim Title As String, Genre As String, Season As String, Tier As String, EPCount As String, EPMethod As String, EPMethodCount As String, AvailTime As String, Commitment As String, ProductionStart As String, PostProduction As String, GridStatus
Dim TitleLength As Variant, ColumnP As String
Set ws1 = Sheets("Drama")
Set ws2 = Sheets("Master Data - Drama & Comedy")
LastR = ws1.Range("H" & Rows.Count).End(xlUp).Row 'Finds last row with data
LastR2 = ws2.Range("E" & Rows.Count).End(xlUp).Row 'Finds last row with data
Application.Goto ws1.Range("H7") 'Loop for Tile Details - Start at row 7
For Each Cell In ws2.Range("B2:B" & LastR2 & "") 'Currently has 17 Items
If Cell.Value = "Backlog" Then
Set CurrCell = ActiveCell
GridStatus = Cell.Value
Title = Cell.Offset(0, 3).Value
TitleLength = Len(Title)
Genre = Cell.Offset(0, 4).Value
Season = Cell.Offset(0, 5).Value
Tier = Cell.Offset(0, 6).Value
EPCount = Cell.Offset(0, 7).Value
EPMethod = Cell.Offset(0, 8).Value
EPMethodCount = Cell.Offset(0, 9).Value
AvailTime = Cell.Offset(0, 10).Value
Commitment = Cell.Offset(0, 11).Value
ProductionStart = Cell.Offset(0, 12).Value
PostProduction = Cell.Offset(0, 13).Value
ColumnP = 2
If CurrCell.Row = 35 Then 'When you get to row 35 start in a new column
CurrCell.Offset(-28, 0).Select 'Resets the activecell back to H7
ColumnP = 4 'Defines the column to change too
End If 'Currcell.row
CurrCell.Offset(0, ColumnP).Value = Title & " | S" & Season & Chr(10) & "Avail Date: " & AvailTime & Chr(10) & "Committed: " & Commitment 'Enters the details of the data into each tile
With CurrCell.Offset(0, ColumnP).Characters(Start:=1, Length:=TitleLength + 5).Font 'Header Title Font +5 is for Additional Season Text
.Name = "Calibri (Body)"
.FontStyle = "Bold"
.Size = 16
End With
With CurrCell.Offset(0, ColumnP).Characters(Start:=TitleLength + 6, Length:=100).Font 'Rest of the Text on Tile +6 is for skipping to the next row and adding in season text to the count
.Name = "Calibri (Body)"
.FontStyle = "Regular"
.Size = 14
End With
CurrCell.Offset(2, 0).Select 'Step down 2 rows
End If 'If Backlog
Next Cell
End Sub